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/compiler/PervEnv/Win32/win32-bin-prim-io.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : monnier 16 (* win32-bin-prim-io.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories.
4 :     *
5 :     * Implementation of Win32 binary primitive IO.
6 :     *
7 :     *)
8 :    
9 :     structure Win32BinPrimIO : OS_PRIM_IO =
10 :     struct
11 :     structure PrimIO = BinPrimIO
12 :    
13 :     structure W32FS = Win32.FileSys
14 :     structure W32IO = Win32.IO
15 :     structure W32G = Win32.General
16 :    
17 :     structure V = Word8Vector
18 :    
19 :     type file_desc = W32G.hndl
20 :    
21 :     val pfi = Position.fromInt
22 :     val pti = Position.toInt
23 :     val pfw = Position.fromInt o W32G.Word.toInt
24 :     val ptw = W32G.Word.fromInt o Position.toInt
25 :    
26 :     val say = W32G.logMsg
27 :    
28 :     fun announce s x y = (
29 :     (** say "Win32BinPrimIO: "; say (s:string); say "\n"; **)
30 :     x y)
31 :    
32 :     val bufferSzB = 4096
33 :    
34 :     val seek = pfw o W32IO.setFilePointer'
35 :    
36 :     fun posFns iod =
37 :     if (OS.IO.kind iod = OS.IO.Kind.file) then
38 :     let val pos : Position.int ref = ref(pfi 0)
39 :     fun getPos () : Position.int = !pos
40 :     fun setPos p =
41 :     pos := announce "setPos:seek"
42 :     seek (W32FS.IODToHndl iod,
43 :     ptw p,
44 :     W32IO.FILE_BEGIN)
45 :     fun endPos () : Position.int =
46 :     (case W32FS.getLowFileSize (W32FS.IODToHndl iod) of
47 :     SOME w => pfw w
48 :     | _ => raise OS.SysErr("endPos: no file size", NONE))
49 :     fun verifyPos () =
50 :     (pos := announce "verifyPos:seek"
51 :     seek (W32FS.IODToHndl iod,
52 :     0wx0,
53 :     W32IO.FILE_CURRENT);
54 :     !pos)
55 :     in
56 :     ignore (verifyPos());
57 :     { pos=pos,
58 :     getPos=SOME getPos,
59 :     setPos=SOME setPos,
60 :     endPos=SOME endPos,
61 :     verifyPos=SOME verifyPos
62 :     }
63 :     end
64 :     else { pos=ref(pfi 0),
65 :     getPos=NONE,setPos=NONE,endPos=NONE,verifyPos=NONE
66 :     }
67 :    
68 :     fun addCheck f (SOME g) = SOME (f g)
69 :     | addCheck _ NONE = NONE
70 :    
71 :     fun mkReader {initBlkMode=false,...} =
72 :     raise IO.NonblockingNotSupported
73 :     | mkReader {fd,name,initBlkMode} =
74 :     let val closed = ref false
75 :     fun ensureOpen f x =
76 :     if !closed then raise IO.ClosedStream else f x
77 :     val blocking = ref initBlkMode
78 :     val iod = W32FS.hndlToIOD fd
79 :     val {pos,getPos,setPos,endPos,verifyPos} = posFns iod
80 :     fun incPos k = pos := Position.+(!pos,pfi k)
81 :     fun readVec n =
82 :     let val v = announce "read"
83 :     W32IO.readVec(W32FS.IODToHndl iod,n)
84 :     in incPos (V.length v); v
85 :     end
86 :     fun readArr arg =
87 :     let val k = announce "readBuf"
88 :     W32IO.readArr(W32FS.IODToHndl iod,arg)
89 :     in incPos k; k
90 :     end
91 :     fun close () =
92 :     if !closed then ()
93 :     else (closed:=true; announce "close"
94 :     W32IO.close (W32FS.IODToHndl iod))
95 :     fun avail () =
96 :     if !closed then SOME 0
97 :     else (case W32FS.getLowFileSize (W32FS.IODToHndl iod) of
98 :     SOME w => SOME(Position.-(pfw w,!pos))
99 :     | NONE => NONE
100 :     )
101 :     in
102 :     PrimIO.RD{
103 :     name = name,
104 :     chunkSize = bufferSzB,
105 :     readVec = SOME(ensureOpen readVec),
106 :     readArr = SOME(ensureOpen readArr),
107 :     readVecNB = NONE,
108 :     readArrNB = NONE,
109 :     block = NONE,
110 :     canInput = NONE,
111 :     avail = avail,
112 :     getPos = getPos,
113 :     setPos = addCheck ensureOpen setPos,
114 :     endPos = addCheck ensureOpen endPos,
115 :     verifyPos = addCheck ensureOpen verifyPos,
116 :     close = close,
117 :     ioDesc = SOME iod
118 :     }
119 :     end
120 :    
121 :     val shareAll = W32G.Word.orb(W32IO.FILE_SHARE_READ,
122 :     W32IO.FILE_SHARE_WRITE)
123 :    
124 :     fun checkHndl name h =
125 :     if W32G.isValidHandle h then h
126 :     else
127 :     raise OS.SysErr ("win32-bin-prim-io:checkHndl: "^name^": failed",NONE)
128 :    
129 :     fun openRd name =
130 :     mkReader{
131 :     fd = checkHndl "openRd"
132 :     (announce ("openRd:createFile:"^name)
133 :     W32IO.createFile{
134 :     name=name,
135 :     access=W32IO.GENERIC_READ,
136 :     share=shareAll,
137 :     mode=W32IO.OPEN_EXISTING,
138 :     attrs=0wx0
139 :     }),
140 :     name = name,
141 :     initBlkMode = true
142 :     }
143 :    
144 :     fun mkWriter {initBlkMode=false,...} =
145 :     raise IO.NonblockingNotSupported
146 :     | mkWriter {fd,name,initBlkMode,appendMode,chunkSize} =
147 :     let val closed = ref false
148 :     val blocking = ref initBlkMode
149 :     fun ensureOpen f x =
150 :     if !closed then raise IO.ClosedStream else f x
151 :     val iod = W32FS.hndlToIOD fd
152 :     val {pos,getPos,setPos,endPos,verifyPos} = posFns iod
153 :     fun incPos k = pos := Position.+(!pos,pfi k)
154 :     fun writeVec v =
155 :     let val k = announce "writeVec"
156 :     W32IO.writeVec (W32FS.IODToHndl iod,v)
157 :     in incPos k; k
158 :     end
159 :     fun writeArr v =
160 :     let val k = announce "writeArr"
161 :     W32IO.writeArr (W32FS.IODToHndl iod,v)
162 :     in incPos k; k
163 :     end
164 :     fun close () =
165 :     if !closed then ()
166 :     else (closed:=true;
167 :     announce "close"
168 :     W32IO.close (W32FS.IODToHndl iod))
169 :     in
170 :     PrimIO.WR{
171 :     name = name,
172 :     chunkSize = chunkSize,
173 :     writeVec = SOME(ensureOpen writeVec),
174 :     writeArr = SOME(ensureOpen writeArr),
175 :     writeVecNB = NONE,
176 :     writeArrNB = NONE,
177 :     block = NONE,
178 :     canOutput = NONE,
179 :     getPos = getPos,
180 :     setPos = addCheck ensureOpen setPos,
181 :     endPos = addCheck ensureOpen endPos,
182 :     verifyPos = addCheck ensureOpen verifyPos,
183 :     close = close,
184 :     ioDesc = SOME iod
185 :     }
186 :     end
187 :    
188 :     fun openWr name =
189 :     mkWriter{
190 :     fd = checkHndl "openWr"
191 :     (announce ("openWr:createFile:"^name)
192 :     W32IO.createFile{
193 :     name=name,
194 :     access=W32IO.GENERIC_WRITE,
195 :     share=shareAll,
196 :     mode=W32IO.CREATE_ALWAYS,
197 :     attrs=W32FS.FILE_ATTRIBUTE_NORMAL
198 :     }),
199 :     name = name,
200 :     initBlkMode = true,
201 :     appendMode = false,
202 :     chunkSize = bufferSzB
203 :     }
204 :    
205 :     fun openApp name =
206 :     let val h = checkHndl "openApp"
207 :     (announce ("openApp:createFile:"^name)
208 :     W32IO.createFile{
209 :     name=name,
210 :     access=W32IO.GENERIC_WRITE,
211 :     share=shareAll,
212 :     mode=W32IO.OPEN_EXISTING,
213 :     attrs=W32FS.FILE_ATTRIBUTE_NORMAL
214 :     })
215 :     val _ = announce "setFilePointer'"
216 :     W32IO.setFilePointer' (h,0wx0,W32IO.FILE_END)
217 :     in
218 :     mkWriter{
219 :     fd = h,
220 :     name = name,
221 :     initBlkMode = true,
222 :     appendMode = true,
223 :     chunkSize = bufferSzB
224 :     }
225 :     end
226 :    
227 :     end
228 :    
229 :     (*
230 : monnier 113 * $Log$
231 : monnier 16 *)

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