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/Unix/posix-bin-prim-io.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/PervEnv/Unix/posix-bin-prim-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)

1 : monnier 16 (* posix-bin-prim-io.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * This implements the UNIX version of the OS specific binary primitive
6 :     * IO structure. The Text IO version is implemented by a trivial translation
7 :     * of these operations (see posix-text-prim-io.sml).
8 :     *
9 :     *)
10 :    
11 :     structure PosixBinPrimIO : OS_PRIM_IO =
12 :     struct
13 :    
14 :     structure PrimIO = BinPrimIO
15 :    
16 :     structure Vec = Word8Vector
17 :     structure PF = Posix.FileSys
18 :     structure PIO = Posix.IO
19 :    
20 :     type file_desc = PF.file_desc
21 :    
22 :     val toFPI = Position.fromInt
23 :    
24 :     fun announce s x y = (
25 :     (*print "Posix: "; print (s:string); print "\n"; *)
26 :     x y)
27 :    
28 :     val bufferSzB = 4096
29 :    
30 :     fun isRegFile fd = PF.ST.isReg(PF.fstat fd)
31 :    
32 :     fun posFns (closed, fd) = if (isRegFile fd)
33 :     then let
34 :     val pos = ref(Position.fromInt 0)
35 :     fun getPos () = !pos
36 :     fun setPos p = (
37 :     if !closed then raise IO.ClosedStream else ();
38 :     pos := announce "lseek" PIO.lseek(fd,p,PIO.SEEK_SET))
39 :     fun endPos () = (
40 :     if !closed then raise IO.ClosedStream else ();
41 :     PF.ST.size(announce "fstat" PF.fstat fd))
42 :     fun verifyPos () = let
43 :     val curPos = PIO.lseek(fd, Position.fromInt 0, PIO.SEEK_CUR)
44 :     in
45 :     pos := curPos; curPos
46 :     end
47 :     in
48 :     ignore (verifyPos());
49 :     { pos = pos,
50 :     getPos = SOME getPos,
51 :     setPos = SOME setPos,
52 :     endPos = SOME endPos,
53 :     verifyPos = SOME verifyPos
54 :     }
55 :     end
56 :     else {
57 :     pos = ref(Position.fromInt 0),
58 :     getPos = NONE, setPos = NONE, endPos = NONE, verifyPos = NONE
59 :     }
60 :    
61 :     fun mkReader {fd, name, initBlkMode} = let
62 :     val closed = ref false
63 :     val {pos, getPos, setPos, endPos, verifyPos} = posFns (closed, fd)
64 :     val blocking = ref initBlkMode
65 :     fun blockingOn () = (PIO.setfl(fd, PIO.O.flags[]); blocking := true)
66 :     fun blockingOff () = (PIO.setfl(fd, PIO.O.nonblock); blocking := false)
67 :     fun incPos k = pos := Position.+(!pos, toFPI k)
68 :     fun readVec n = let
69 :     val v = announce "read" PIO.readVec(fd, n)
70 :     in
71 :     incPos (Vec.length v); v
72 :     end
73 :     fun readArr arg = let
74 :     val k = announce "readBuf" PIO.readArr(fd, arg)
75 :     in
76 :     incPos k; k
77 :     end
78 :     fun blockWrap f x = (
79 :     if !closed then raise IO.ClosedStream else ();
80 :     if !blocking then () else blockingOn();
81 :     f x)
82 :     fun noBlockWrap f x = (
83 :     if !closed then raise IO.ClosedStream else ();
84 :     if !blocking then blockingOff() else ();
85 :     ((* try *) SOME(f x)
86 :     handle (e as OS.SysErr(_, SOME cause)) =>
87 :     if cause = Posix.Error.again then NONE else raise e
88 :     (* end try *)))
89 :     fun close () = if !closed
90 :     then ()
91 :     else (closed:=true; announce "close" PIO.close fd)
92 :     val isReg = isRegFile fd
93 :     fun avail () = if !closed
94 :     then SOME 0
95 :     else if isReg
96 :     then SOME(Position.-(PF.ST.size(PF.fstat fd), !pos))
97 :     else NONE
98 :     in
99 :     BinPrimIO.RD{
100 :     name = name,
101 :     chunkSize = bufferSzB,
102 :     readVec = SOME(blockWrap readVec),
103 :     readArr = SOME(blockWrap readArr),
104 :     readVecNB = SOME(noBlockWrap readVec),
105 :     readArrNB = SOME(noBlockWrap readArr),
106 :     block = NONE,
107 :     canInput = NONE,
108 :     avail = avail,
109 :     getPos = getPos,
110 :     setPos = setPos,
111 :     endPos = endPos,
112 :     verifyPos = verifyPos,
113 :     close = close,
114 :     ioDesc = SOME(PF.fdToIOD fd)
115 :     }
116 :     end
117 :    
118 :    
119 :     fun openRd name = mkReader{
120 :     fd = announce "openf" PF.openf(name,PIO.O_RDONLY,PF.O.flags[]),
121 :     name = name,
122 :     initBlkMode = true
123 :     }
124 :    
125 :    
126 :     fun mkWriter {fd, name, initBlkMode, appendMode, chunkSize} = let
127 :     val closed = ref false
128 :     val {pos, getPos, setPos, endPos, verifyPos} = posFns (closed, fd)
129 :     fun incPos k = (pos := Position.+(!pos, toFPI k); k)
130 :     val blocking = ref initBlkMode
131 :     val appendFS = PIO.O.flags(if appendMode then [PIO.O.append] else nil)
132 :     fun updateStatus() = let
133 :     val flgs = if !blocking
134 :     then appendFS
135 :     else PIO.O.flags[PIO.O.nonblock, appendFS]
136 :     in
137 :     announce "setfl" PIO.setfl(fd, flgs)
138 :     end
139 :     fun ensureOpen () = if !closed then raise IO.ClosedStream else ()
140 :     fun ensureBlock (x) =
141 :     if !blocking = x then () else (blocking := x; updateStatus())
142 :     fun putV x = incPos(announce "writeVec" PIO.writeVec x)
143 :     fun putA x = incPos(announce "writeArr" PIO.writeArr x)
144 :     fun write (put, block) arg = (
145 :     ensureOpen(); ensureBlock block;
146 :     put(fd, arg))
147 :     fun handleBlock writer arg = SOME(writer arg)
148 :     handle (e as OS.SysErr(_, SOME cause)) =>
149 :     if cause = Posix.Error.again then NONE else raise e
150 :     fun close () = if !closed
151 :     then ()
152 :     else (closed:=true; announce "close" PIO.close fd)
153 :     in
154 :     BinPrimIO.WR{
155 :     name = name,
156 :     chunkSize = chunkSize,
157 :     writeVec = SOME(write(putV,true)),
158 :     writeArr = SOME(write(putA,true)),
159 :     writeVecNB = SOME(handleBlock(write(putV,false))),
160 :     writeArrNB = SOME(handleBlock(write(putA,false))),
161 :     block = NONE,
162 :     canOutput = NONE,
163 :     getPos = getPos,
164 :     setPos = setPos,
165 :     endPos = endPos,
166 :     verifyPos = verifyPos,
167 :     ioDesc = SOME(PF.fdToIOD fd),
168 :     close = close
169 :     }
170 :     end
171 :    
172 :     val standardMode = PF.S.flags[ (* mode 0666 *)
173 :     PF.S.irusr, PF.S.iwusr,
174 :     PF.S.irgrp, PF.S.iwgrp,
175 :     PF.S.iroth, PF.S.iwoth
176 :     ]
177 :     fun createFile (name, mode, flags) =
178 :     announce "createf" PF.createf(name, mode, flags, standardMode)
179 :    
180 :     fun openWr name = mkWriter{
181 :     fd=createFile(name, PIO.O_WRONLY, PF.O.trunc),
182 :     name=name,
183 :     initBlkMode=true,
184 :     appendMode=false,
185 :     chunkSize=bufferSzB
186 :     }
187 :    
188 :     fun openApp name = mkWriter{
189 :     fd = createFile(name, PIO.O_WRONLY, PF.O.append),
190 :     name = name,
191 :     initBlkMode = true,
192 :     appendMode = true,
193 :     chunkSize = bufferSzB
194 :     }
195 :    
196 :     end; (* PosixBinPrimIO *)
197 :    
198 :    
199 :     (*
200 :     * $Log: posix-bin-prim-io.sml,v $
201 :     * Revision 1.2 1997/06/07 15:27:52 jhr
202 :     * SML'97 Basis Library changes (phase 3; Posix changes)
203 :     *
204 :     * Revision 1.1.1.1 1997/01/14 01:38:25 george
205 :     * Version 109.24
206 :     *
207 :     *)

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