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

SCM Repository

[smlnj] Diff of /sml/branches/blume-private-devel/src/system/Basis/Implementation/Posix/posix-io.sml
ViewVC logotype

Diff of /sml/branches/blume-private-devel/src/system/Basis/Implementation/Posix/posix-io.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1492, Tue May 18 21:19:57 2004 UTC revision 1493, Tue May 18 21:19:57 2004 UTC
# Line 9  Line 9 
9  local  local
10      structure SysWord = SysWordImp      structure SysWord = SysWordImp
11      structure Int = IntImp      structure Int = IntImp
12        structure Position = PositionImp
13  in  in
14  structure POSIX_IO =  structure POSIX_IO =
15    struct    struct
# Line 131  Line 132 
132      structure FLock =      structure FLock =
133        struct        struct
134          datatype flock = FLOCK of {          datatype flock = FLOCK of {
135               l_type : lock_type,               ltype : lock_type,
136               l_whence : whence,               whence : whence,
137               l_start : Position.int,               start : Position.int,
138               l_len : Position.int,               len : Position.int,
139               l_pid : pid option               pid : pid option
140             }             }
141    
142          fun flock fv = FLOCK fv          fun flock fv = FLOCK fv
143          fun ltype (FLOCK{l_type,...}) = l_type          fun ltype (FLOCK fv) = #ltype fv
144          fun whence (FLOCK{l_whence,...}) = l_whence          fun whence (FLOCK fv) = #whence fv
145          fun start (FLOCK{l_start,...}) = l_start          fun start (FLOCK fv) = #start fv
146          fun len (FLOCK{l_len,...}) = l_len          fun len (FLOCK fv) = #len fv
147          fun pid (FLOCK{l_pid,...}) = l_pid          fun pid (FLOCK fv) = #pid fv
148        end        end
149    
150      type flock_rep = s_int * s_int * Position.int * Position.int * s_int      type flock_rep = s_int * s_int * Position.int * Position.int * s_int
# Line 156  Line 157 
157      val f_wrlck = osval "F_WRLCK"      val f_wrlck = osval "F_WRLCK"
158      val f_unlck = osval "F_UNLCK"      val f_unlck = osval "F_UNLCK"
159    
160      fun flockToRep (FLock.FLOCK{l_type,l_whence,l_start,l_len,...}) = let      fun flockToRep (FLock.FLOCK{ltype,whence,start,len,...}) = let
161            fun ltypeOf F_RDLCK = f_rdlck            fun ltypeOf F_RDLCK = f_rdlck
162              | ltypeOf F_WRLCK = f_wrlck              | ltypeOf F_WRLCK = f_wrlck
163              | ltypeOf F_UNLCK = f_unlck              | ltypeOf F_UNLCK = f_unlck
164            in            in
165              (ltypeOf l_type,whToWord l_whence, l_start, l_len, 0)              (ltypeOf ltype,whToWord whence, start, len, 0)
166            end            end
167      fun flockFromRep (usepid,(ltype,whence,start,len,pid)) = let      fun flockFromRep (usepid,(ltype,whence,start,len,pid)) = let
168            fun ltypeOf ltype =            fun ltypeOf ltype =
# Line 171  Line 172 
172                  else fail ("flockFromRep","unknown lock type "^(Int.toString ltype))                  else fail ("flockFromRep","unknown lock type "^(Int.toString ltype))
173            in            in
174              FLock.FLOCK {              FLock.FLOCK {
175                l_type = ltypeOf ltype,                ltype = ltypeOf ltype,
176                l_whence = whFromWord whence,                whence = whFromWord whence,
177                l_start = start,                start = start,
178                l_len = len,                len = len,
179                l_pid = if usepid then SOME(POSIX_Process.PID pid) else NONE                pid = if usepid then SOME(POSIX_Process.PID pid) else NONE
180              }              }
181            end            end
182    
# Line 192  Line 193 
193      val fsync' : s_int -> unit = cfun "fsync"      val fsync' : s_int -> unit = cfun "fsync"
194      fun fsync fd = fsync' (FS.intOf fd)      fun fsync fd = fsync' (FS.intOf fd)
195    
196    end (* structure POSIX_IO *)  
197        (*
198         * Making readers and writers...
199         *   (code lifted from posix-bin-prim-io.sml and posix-text-prim-io.sml)
200         *)
201        fun announce s x y = (
202              (*print "Posix: "; print (s:string); print "\n"; *)
203              x y)
204    
205        val bufferSzB = 4096
206    
207        fun isRegFile fd = FS.ST.isReg(FS.fstat fd)
208    
209        fun posFns (closed, fd) =
210            if isRegFile fd then
211                let val pos = ref (Position.fromInt 0)
212                    fun getPos () = !pos
213                    fun setPos p =
214                        (if !closed then raise IO.ClosedStream else ();
215                         pos := announce "lseek" lseek (fd, p, SEEK_SET))
216                    fun endPos () =
217                        (if !closed then raise IO.ClosedStream else ();
218                         FS.ST.size(announce "fstat" FS.fstat fd))
219                    fun verifyPos () =
220                        let val curPos = lseek (fd, Position.fromInt 0, SEEK_CUR)
221                        in
222                            pos := curPos; curPos
223                        end
224                in
225                    ignore (verifyPos ());
226                    { pos = pos,
227                      getPos = SOME getPos,
228                      setPos = SOME setPos,
229                      endPos = SOME endPos,
230                      verifyPos = SOME verifyPos }
231                end
232            else { pos = ref (Position.fromInt 0),
233                   getPos = NONE, setPos = NONE, endPos = NONE, verifyPos = NONE }
234    
235        fun mkReader { mkRD, cvtVec, cvtArrSlice } { fd, name, initBlkMode } =
236            let val closed = ref false
237                val {pos, getPos, setPos, endPos, verifyPos} = posFns (closed, fd)
238                val blocking = ref initBlkMode
239                fun blockingOn () = (setfl(fd, O.flags[]); blocking := true)
240                fun blockingOff () = (setfl(fd, O.nonblock); blocking := false)
241                fun incPos k = pos := Position.+(!pos, Position.fromInt k)
242                fun r_readVec n =
243                    let val v = announce "read" readVec(fd, n)
244                    in
245                        incPos (Word8Vector.length v);
246                        cvtVec v
247                    end
248                fun r_readArr arg =
249                    let val k = announce "readBuf" readArr(fd, cvtArrSlice arg)
250                    in
251                        incPos k; k
252                    end
253                fun blockWrap f x =
254                    (if !closed then raise IO.ClosedStream else ();
255                     if !blocking then () else blockingOn();
256                     f x)
257                fun noBlockWrap f x =
258                    (if !closed then raise IO.ClosedStream else ();
259                     if !blocking then blockingOff() else ();
260                     ((* try *) SOME (f x)
261                                handle (e as Assembly.SysErr(_, SOME cause)) =>
262                                       if cause = POSIX_Error.again then NONE
263                                       else raise e
264                      (* end try *)))
265                fun r_close () =
266                    if !closed then ()
267                    else (closed:=true; announce "close" close fd)
268                val isReg = isRegFile fd
269                fun avail () =
270                    if !closed then SOME 0
271                    else if isReg then
272                        SOME(Position.-(FS.ST.size(FS.fstat fd), !pos))
273                    else NONE
274            in
275                mkRD { name = name,
276                       chunkSize = bufferSzB,
277                       readVec = SOME (blockWrap r_readVec),
278                       readArr = SOME (blockWrap r_readArr),
279                       readVecNB = SOME (noBlockWrap r_readVec),
280                       readArrNB = SOME (noBlockWrap r_readArr),
281                       block = NONE,
282                       canInput = NONE,
283                       avail = avail,
284                       getPos = getPos,
285                       setPos = setPos,
286                       endPos = endPos,
287                       verifyPos = verifyPos,
288                       close = r_close,
289                       ioDesc = SOME (FS.fdToIOD fd) }
290            end
291    
292        fun mkWriter { mkWR, cvtVecSlice, cvtArrSlice }
293                     { fd, name, initBlkMode, appendMode, chunkSize } =
294            let val closed = ref false
295                val {pos, getPos, setPos, endPos, verifyPos} = posFns (closed, fd)
296                fun incPos k = (pos := Position.+(!pos, Position.fromInt k); k)
297                val blocking = ref initBlkMode
298                val appendFS = O.flags(if appendMode then [O.append] else nil)
299                fun updateStatus() =
300                    let val flgs = if !blocking then appendFS
301                                   else O.flags[O.nonblock, appendFS]
302                    in
303                        announce "setfl" setfl(fd, flgs)
304  end  end
305              fun ensureOpen () = if !closed then raise IO.ClosedStream else ()
306              fun ensureBlock (x) =
307                  if !blocking = x then () else (blocking := x; updateStatus())
308              fun writeVec' (fd, s) = writeVec (fd, cvtVecSlice s)
309              fun writeArr' (fd, s) = writeArr (fd, cvtArrSlice s)
310              fun putV x = incPos (announce "writeVec" writeVec' x)
311              fun putA x = incPos (announce "writeArr" writeArr' x)
312              fun write (put, block) arg =
313                  (ensureOpen();
314                   ensureBlock block;
315                   put(fd, arg))
316              fun handleBlock writer arg =
317                  SOME (writer arg)
318                  handle (e as Assembly.SysErr(_, SOME cause)) =>
319                         if cause = POSIX_Error.again then NONE else raise e
320              fun w_close () =
321                  if !closed then ()
322                  else (closed:=true; announce "close" close fd)
323            in
324                mkWR { name = name,
325                       chunkSize = chunkSize,
326                       writeVec = SOME(write(putV,true)),
327                       writeArr = SOME(write(putA,true)),
328                       writeVecNB = SOME(handleBlock(write(putV,false))),
329                       writeArrNB = SOME(handleBlock(write(putA,false))),
330                       block = NONE,
331                       canOutput = NONE,
332                       getPos = getPos,
333                       setPos = setPos,
334                       endPos = endPos,
335                       verifyPos = verifyPos,
336                       ioDesc = SOME (FS.fdToIOD fd),
337                       close = w_close }
338            end
339    
340        val mkBinReader = mkReader { mkRD = BinPrimIO.RD,
341                                     cvtVec = fn v => v,
342                                     cvtArrSlice = fn s => s }
343    
344        val mkTextReader = mkReader { mkRD = TextPrimIO.RD,
345                                      cvtVec = Byte.bytesToString,
346                                      cvtArrSlice = (* gross hack!!! *)
347                                        fn (s : CharArraySlice.slice) =>
348                                           InlineT.cast s : Word8ArraySlice.slice }
349    
350        val mkBinWriter = mkWriter { mkWR = BinPrimIO.WR,
351                                     cvtVecSlice = fn s => s,
352                                     cvtArrSlice = fn s => s }
353    
354        val mkTextWriter = mkWriter { mkWR = TextPrimIO.WR,
355                                      cvtVecSlice = (* gross hack!!! *)
356                                        fn (s : CharVectorSlice.slice) =>
357                                           InlineT.cast s : Word8VectorSlice.slice,
358                                      cvtArrSlice = (* gross hack!!! *)
359                                        fn (s : CharArraySlice.slice) =>
360                                           InlineT.cast s : Word8ArraySlice.slice }
361    
362      end (* structure POSIX_IO *)
363    end

Legend:
Removed from v.1492  
changed lines
  Added in v.1493

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