Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cml/src/Win32/win32-bin-prim-io.sml
ViewVC logotype

Annotation of /sml/trunk/src/cml/src/Win32/win32-bin-prim-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 167 - (view) (download)
Original Path: sml/branches/SMLNJ/src/cml/src/Win32/win32-bin-prim-io.sml

1 : monnier 137 (* win32-bin-prim-io.sml
2 :     *
3 :     * COPYRIGHT (c) 1998 Bell Labs, Lucent Technologies.
4 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
5 :     *
6 :     * This implements the Win32 version of the OS specific binary primitive
7 :     * IO structure. The Text IO version is implemented by a trivial translation
8 :     * of these operations (see nt-text-prim-io.sml).
9 :     *)
10 :    
11 :     structure Win32BinPrimIO : OS_PRIM_IO =
12 :     struct
13 :    
14 :     structure SV = SyncVar
15 :    
16 :     structure PrimIO = BinPrimIO
17 :    
18 :     structure W32FS = Win32.FileSys
19 :     structure W32IO = Win32.IO
20 :     structure W32G = Win32.General
21 :    
22 :     structure V = Word8Vector
23 :    
24 :     type file_desc = W32G.hndl
25 :    
26 :     val pfi = Position.fromInt
27 :     val pti = Position.toInt
28 :     val pfw = Position.fromInt o W32G.Word.toInt
29 :     val ptw = W32G.Word.fromInt o Position.toInt
30 :    
31 :     val say = W32G.logMsg
32 :    
33 :     val bufferSzB = 4096
34 :    
35 :     val seek = pfw o W32IO.setFilePointer'
36 :    
37 :     fun posFns iod =
38 :     if (OS.IO.kind iod = OS.IO.Kind.file)
39 :     then let
40 :     val pos : Position.int ref = ref(pfi 0)
41 :     fun getPos () : Position.int = !pos
42 :     fun setPos p =
43 :     pos := seek (W32FS.IODToHndl iod, ptw p, W32IO.FILE_BEGIN)
44 :     fun endPos () : Position.int = (
45 :     case W32FS.getLowFileSize (W32FS.IODToHndl iod)
46 :     of SOME w => pfw w
47 :     | _ => raise OS.SysErr("endPos: no file size", NONE)
48 :     (* end case *))
49 :     fun verifyPos () = (
50 :     pos := seek (W32FS.IODToHndl iod, 0wx0, W32IO.FILE_CURRENT);
51 :     !pos)
52 :     in
53 :     ignore (verifyPos());
54 :     { pos=pos,
55 :     getPos=SOME getPos,
56 :     setPos=SOME setPos,
57 :     endPos=SOME endPos,
58 :     verifyPos=SOME verifyPos
59 :     }
60 :     end
61 :     else {
62 :     pos=ref(pfi 0),
63 :     getPos=NONE,setPos=NONE,endPos=NONE,verifyPos=NONE
64 :     }
65 :    
66 :     fun addCheck f (SOME g) = SOME (f g)
67 :     | addCheck _ NONE = NONE
68 :    
69 :     fun mkReader {fd, name} = let
70 :     val iod = W32FS.hndlToIOD fd
71 :     val lockMV = SV.mVarInit()
72 :     fun withLock f x = (
73 :     SV.mTake lockMV;
74 :     (Syscall.doSyscall f x) before SV.mPut(lockMV, ()))
75 :     handle ex => (SV.mPut(lockMV, ()); raise ex)
76 :     fun withLock' NONE = NONE
77 :     | withLock' (SOME f) = SOME(withLock f)
78 :     val closed = ref false
79 :     val {pos, getPos, setPos, endPos, verifyPos} = posFns iod
80 :     fun incPos k = pos := Position.+(!pos, pfi k)
81 :     fun blockWrap f x = (
82 :     if !closed then raise IO.ClosedStream else ();
83 :     f x)
84 :     val readEvt =
85 :     IOManager.ioEvt(OS.IO.pollIn(Option.valOf(OS.IO.pollDesc iod)))
86 :     fun eventWrap f x = CML.withNack (fn nack => (
87 :     if !closed then raise IO.ClosedStream else ();
88 :     case (SV.mTakePoll lockMV)
89 :     of NONE => let
90 :     val replV = SV.iVar()
91 :     in
92 :     CML.spawn(fn () => CML.select [
93 :     CML.wrap (readEvt, fn _ => SV.iPut(replV, ())),
94 :     nack
95 :     ]);
96 :     CML.wrap(SV.iGetEvt replV, fn _ => f x)
97 :     end
98 :     | (SOME _) => CML.wrap (readEvt,
99 :     fn _ => (SV.mPut(lockMV, ()); f x))
100 :     (* end case *)))
101 :     fun readVec n = let
102 :     val _ = CML.sync readEvt
103 :     val v = W32IO.readVec (W32FS.IODToHndl iod,n)
104 :     in
105 :     incPos (V.length v); v
106 :     end
107 :     fun readArr arg = let
108 :     val _ = CML.sync readEvt
109 :     val k = W32IO.readArr(W32FS.IODToHndl iod,arg)
110 :     in
111 :     incPos k; k
112 :     end
113 :     fun close () = if !closed
114 :     then ()
115 :     else (closed:=true; W32IO.close (W32FS.IODToHndl iod))
116 :     fun avail () = if !closed
117 :     then SOME 0
118 :     else (case W32FS.getLowFileSize (W32FS.IODToHndl iod)
119 :     of SOME w => SOME (Position.-(pfw w,!pos))
120 :     | NONE => NONE
121 :     (* end case *))
122 :     in
123 :     BinPrimIO.RD{
124 :     name = name,
125 :     chunkSize = bufferSzB,
126 :     readVec = withLock (blockWrap readVec),
127 :     readArr = withLock (blockWrap readArr),
128 :     readVecEvt = eventWrap readVec,
129 :     readArrEvt = eventWrap readArr,
130 :     avail = withLock avail,
131 :     getPos = withLock' getPos,
132 :     setPos = withLock' setPos,
133 :     endPos = withLock' endPos,
134 :     verifyPos = withLock' verifyPos,
135 :     close = withLock close,
136 :     ioDesc = SOME iod
137 :     }
138 :     end
139 :    
140 :    
141 :     val shareAll = W32G.Word.orb(W32IO.FILE_SHARE_READ, W32IO.FILE_SHARE_WRITE)
142 :    
143 :     fun checkHndl name h = if W32G.isValidHandle h
144 :     then h
145 :     else raise OS.SysErr("win32-bin-prim-io:checkHndl: "^name^": failed",NONE)
146 :    
147 :     fun openRd name = mkReader{
148 :     fd = checkHndl "openRd" (W32IO.createFile {
149 :     name=name,
150 :     access=W32IO.GENERIC_READ,
151 :     share=shareAll,
152 :     mode=W32IO.OPEN_EXISTING,
153 :     attrs=0wx0
154 :     }),
155 :     name = name
156 :     }
157 :    
158 :     fun mkWriter {fd, name, appendMode, chunkSize} = let
159 :     val iod = W32FS.hndlToIOD fd
160 :     val lockMV = SV.mVarInit()
161 :     fun withLock f x = (
162 :     SV.mTake lockMV;
163 :     (Syscall.doSyscall f x) before SV.mPut(lockMV, ()))
164 :     handle ex => (SV.mPut(lockMV, ()); raise ex)
165 :     fun withLock' NONE = NONE
166 :     | withLock' (SOME f) = SOME(withLock f)
167 :     val closed = ref false
168 :     fun ensureOpen () = if !closed then raise IO.ClosedStream else ()
169 :     fun putV x = W32IO.writeVec x
170 :     fun putA x = W32IO.writeArr x
171 :     fun write put arg = (ensureOpen(); put(W32FS.IODToHndl iod, arg))
172 :     val writeEvt =
173 :     IOManager.ioEvt(OS.IO.pollOut(Option.valOf(OS.IO.pollDesc iod)))
174 :     fun eventWrap f x = CML.withNack (fn nack => (
175 :     if !closed then raise IO.ClosedStream else ();
176 :     case (SV.mTakePoll lockMV)
177 :     of NONE => let
178 :     val replV = SV.iVar()
179 :     in
180 :     CML.spawn(fn () => CML.select [
181 :     CML.wrap (writeEvt, fn _ => SV.iPut(replV, ())),
182 :     nack
183 :     ]);
184 :     CML.wrap(SV.iGetEvt replV, fn _ => f x)
185 :     end
186 :     | (SOME _) => CML.wrap (writeEvt,
187 :     fn _ => (SV.mPut(lockMV, ()); f x))
188 :     (* end case *)))
189 :     fun close () = if !closed
190 :     then ()
191 :     else (closed:=true; W32IO.close (W32FS.IODToHndl iod))
192 :     val {pos, getPos, setPos, endPos, verifyPos} = posFns (iod)
193 :     in
194 :     BinPrimIO.WR{
195 :     name = name,
196 :     chunkSize = chunkSize,
197 :     writeVec = withLock (write putV),
198 :     writeArr = withLock (write putA),
199 :     writeVecEvt = eventWrap (write putV),
200 :     writeArrEvt = eventWrap (write putA),
201 :     getPos = withLock' getPos,
202 :     setPos = withLock' setPos,
203 :     endPos = withLock' endPos,
204 :     verifyPos = withLock' verifyPos,
205 :     close = withLock close,
206 :     ioDesc = SOME iod
207 :     }
208 :     end
209 :    
210 :     fun openWr name = mkWriter{
211 :     fd = checkHndl "openWr" (W32IO.createFile{
212 :     name=name,
213 :     access=W32IO.GENERIC_WRITE,
214 :     share=shareAll,
215 :     mode=W32IO.CREATE_ALWAYS,
216 :     attrs=W32FS.FILE_ATTRIBUTE_NORMAL
217 :     }),
218 :     name = name,
219 :     appendMode = false,
220 :     chunkSize = bufferSzB
221 :     }
222 :    
223 :     fun openApp name = let
224 :     val h = checkHndl "openApp" (W32IO.createFile {
225 :     name=name,
226 :     access=W32IO.GENERIC_WRITE,
227 :     share=shareAll,
228 :     mode=W32IO.OPEN_EXISTING,
229 :     attrs=W32FS.FILE_ATTRIBUTE_NORMAL
230 :     })
231 :     val _ = W32IO.setFilePointer' (h,0wx0,W32IO.FILE_END)
232 :     in
233 :     mkWriter{fd = h, name = name, appendMode = true, chunkSize = bufferSzB}
234 :     end
235 :    
236 :     end; (* Win32BinPrimIO *)
237 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0