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/Posix/posix-filesys.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/PervEnv/Posix/posix-filesys.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 94 - (view) (download)

1 : monnier 16 (* posix-filesys.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * Structure for POSIX 1003.1 file system operations
6 :     *
7 :     *)
8 :    
9 :     structure POSIX_FileSys =
10 :     struct
11 :     val ++ = SysWord.orb
12 :     val & = SysWord.andb
13 :     infix ++ &
14 :    
15 :     type word = SysWord.word
16 :     type s_int = SysInt.int
17 :    
18 :     fun cfun x = CInterface.c_function "POSIX-FileSys" x
19 :     val osval : string -> s_int = cfun "osval"
20 :     val w_osval = SysWord.fromInt o osval
21 :    
22 :     datatype uid = UID of word
23 :     datatype gid = GID of word
24 :    
25 :     datatype file_desc = FD of {fd : s_int}
26 :     fun intOf (FD{fd,...}) = fd
27 :     fun fd fd = FD{fd=fd}
28 :     fun fdToWord (FD{fd,...}) = SysWord.fromInt fd
29 :     fun wordToFD fd = FD{fd = SysWord.toInt fd}
30 :    
31 :     (* conversions between OS.IO.iodesc values and Posix file descriptors. *)
32 :     fun fdToIOD (FD{fd,...}) = OS.IO.IODesc fd
33 :     fun iodToFD (OS.IO.IODesc fd) = SOME(FD{fd = fd})
34 :    
35 :     val o_rdonly = w_osval "O_RDONLY"
36 :     val o_wronly = w_osval "O_WRONLY"
37 :     val o_rdwr = w_osval "O_RDWR"
38 :    
39 :     datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
40 :     fun omodeFromWord omode =
41 :     if omode = o_rdonly then O_RDONLY
42 :     else if omode = o_wronly then O_WRONLY
43 :     else if omode = o_rdwr then O_RDWR
44 :     else raise Fail ("POSIX_FileSys.omodeFromWord: unknown mode "^
45 :     (Word32.toString omode))
46 :    
47 :     fun omodeToWord O_RDONLY = o_rdonly
48 :     | omodeToWord O_WRONLY = o_wronly
49 :     | omodeToWord O_RDWR = o_rdwr
50 :    
51 :     fun uidToWord (UID i) = i
52 :     fun wordToUid i = UID i
53 :     fun gidToWord (GID i) = i
54 :     fun wordToGid i = GID i
55 :    
56 :     type c_dirstream = Assembly.object (* the underlying C DIRSTREAM *)
57 :    
58 :     datatype dirstream = DS of {
59 :     dirStrm : c_dirstream,
60 :     isOpen : bool ref
61 :     }
62 :    
63 :     val opendir' : string -> c_dirstream = cfun "opendir"
64 :     val readdir' : c_dirstream -> string = cfun "readdir"
65 :     val rewinddir' : c_dirstream -> unit = cfun "rewinddir"
66 :     val closedir' : c_dirstream -> unit = cfun "closedir"
67 :     fun opendir path = DS{
68 :     dirStrm = opendir' path,
69 :     isOpen = ref true
70 :     }
71 :     fun readdir (DS{dirStrm, isOpen = ref false}) =
72 :     raise Assembly.SysErr("readdir on closed directory stream", NONE)
73 :     | readdir (DS{dirStrm, ...}) = readdir' dirStrm
74 :     fun rewinddir (DS{dirStrm, isOpen = ref false}) =
75 :     raise Assembly.SysErr("rewinddir on closed directory stream", NONE)
76 :     | rewinddir (DS{dirStrm, ...}) = rewinddir' dirStrm
77 :     fun closedir (DS{dirStrm, isOpen = ref false}) = ()
78 :     | closedir (DS{dirStrm, isOpen}) = (
79 :     isOpen := false;
80 :     closedir' dirStrm)
81 :    
82 :     val chdir : string -> unit = cfun "chdir"
83 :     val getcwd : unit -> string = cfun "getcwd"
84 :    
85 :     val stdin = fd 0
86 :     val stdout = fd 1
87 :     val stderr = fd 2
88 :    
89 :     structure S =
90 :     struct
91 :     datatype flags = MODE of word
92 :     type mode = flags
93 :    
94 :     fun fromWord w = MODE w
95 :     fun toWord (MODE w) = w
96 :    
97 :     fun flags ms = MODE(List.foldl (fn (MODE m,acc) => m ++ acc) 0w0 ms)
98 :     fun anySet (MODE m, MODE m') = (m & m') <> 0w0
99 :     fun allSet (MODE m, MODE m') = (m & m') = m
100 :    
101 :     val irwxu = MODE(w_osval "irwxu")
102 :     val irusr = MODE(w_osval "irusr")
103 :     val iwusr = MODE(w_osval "iwusr")
104 :     val ixusr = MODE(w_osval "ixusr")
105 :     val irwxg = MODE(w_osval "irwxg")
106 :     val irgrp = MODE(w_osval "irgrp")
107 :     val iwgrp = MODE(w_osval "iwgrp")
108 :     val ixgrp = MODE(w_osval "ixgrp")
109 :     val irwxo = MODE(w_osval "irwxo")
110 :     val iroth = MODE(w_osval "iroth")
111 :     val iwoth = MODE(w_osval "iwoth")
112 :     val ixoth = MODE(w_osval "ixoth")
113 :     val isuid = MODE(w_osval "isuid")
114 :     val isgid = MODE(w_osval "isgid")
115 :    
116 :     end
117 :    
118 :     structure O =
119 :     struct
120 :     datatype flags = OFL of word
121 :    
122 :     fun fromWord w = OFL w
123 :     fun toWord (OFL w) = w
124 :    
125 :     fun flags ms = OFL(List.foldl (fn (OFL m,acc) => m ++ acc) 0w0 ms)
126 :     fun anySet (OFL m, OFL m') = (m & m') <> 0w0
127 :     fun allSet (OFL m, OFL m') = (m & m') = m
128 :    
129 :     val append = OFL(w_osval "O_APPEND")
130 :     val dsync = OFL(w_osval "O_DSYNC")
131 :     val excl = OFL(w_osval "O_EXCL")
132 :     val noctty = OFL(w_osval "O_NOCTTY")
133 :     val nonblock = OFL(w_osval "O_NONBLOCK")
134 :     val rsync = OFL(w_osval "O_RSYNC")
135 :     val sync = OFL(w_osval "O_SYNC")
136 :     val o_trunc = w_osval "O_TRUNC"
137 :     val trunc = OFL o_trunc
138 :     val o_creat = w_osval "O_CREAT"
139 :     val crflags = o_wronly ++ o_creat ++ o_trunc
140 :    
141 :     end
142 :    
143 :     val openf' : string * word * word -> s_int = cfun "openf"
144 :     fun openf (fname, omode, O.OFL flags) =
145 :     fd(openf'(fname, flags ++ (omodeToWord omode), 0w0))
146 :     fun createf (fname, omode, O.OFL oflags, S.MODE mode) = let
147 :     val flags = O.o_creat ++ oflags ++ (omodeToWord omode)
148 :     in
149 :     fd(openf'(fname, flags, mode))
150 :     end
151 :     fun creat (fname, S.MODE mode) =
152 :     fd(openf'(fname, O.crflags, mode))
153 :    
154 :     val umask' : word -> word = cfun "umask"
155 :     fun umask (S.MODE mode) = S.MODE(umask' mode)
156 :    
157 :     val link' : string * string -> unit = cfun "link"
158 :     fun link {old, new} = link'(old,new)
159 :     val rename' : string * string -> unit = cfun "rename"
160 :     fun rename {old, new} = rename'(old,new)
161 :     val symlink' : string * string -> unit = cfun "symlink"
162 :     fun symlink {old, new} = symlink'(old,new)
163 :    
164 :     val mkdir' : string * word -> unit = cfun "mkdir"
165 :     fun mkdir (dirname, S.MODE mode) = mkdir'(dirname,mode)
166 :    
167 :     val mkfifo' : string * word -> unit = cfun "mkfifo"
168 :     fun mkfifo (name, S.MODE mode) = mkfifo'(name,mode)
169 :    
170 :     val unlink : string -> unit = cfun "unlink"
171 :     val rmdir : string -> unit = cfun "rmdir"
172 :     val readlink : string -> string = cfun "readlink"
173 :    
174 :     val ftruncate' : s_int * Position.int -> unit = cfun "ftruncate"
175 :     fun ftruncate (FD{fd,...}, len) = ftruncate' (fd, len);
176 :    
177 :     datatype dev = DEV of word
178 :     fun devToWord (DEV i) = i
179 :     fun wordToDev i = DEV i
180 :    
181 :     datatype ino = INO of word
182 :     fun inoToWord (INO i) = i
183 :     fun wordToIno i = INO i
184 :    
185 :     structure ST =
186 :     struct
187 :     datatype stat = ST of {
188 :     ftype : s_int,
189 :     mode : S.mode,
190 :     ino : ino,
191 :     dev : dev,
192 :     nlink : int,
193 :     uid : uid,
194 :     gid : gid,
195 :     size : Position.int,
196 :     atime : Time.time,
197 :     mtime : Time.time,
198 :     ctime : Time.time
199 :     }
200 :     (* The following assumes the C stat functions pull the
201 :     * file type from the mode field and return the
202 :     * integer below corresponding to the file type.
203 :     *)
204 :     fun isDir (ST{ftype, ...}) = (ftype = 0x4000)
205 :     fun isChr (ST{ftype, ...}) = (ftype = 0x2000)
206 :     fun isBlk (ST{ftype, ...}) = (ftype = 0x6000)
207 :     fun isReg (ST{ftype, ...}) = (ftype = 0x8000)
208 :     fun isFIFO (ST{ftype, ...}) = (ftype = 0x1000)
209 :     fun isLink (ST{ftype, ...}) = (ftype = 0xA000)
210 :     fun isSock (ST{ftype, ...}) = (ftype = 0xC000)
211 :    
212 :     fun mode (ST{mode,...}) = mode
213 :     fun ino (ST{ino,...}) = ino
214 :     fun dev (ST{dev,...}) = dev
215 :     fun nlink (ST{nlink,...}) = nlink
216 :     fun uid (ST{uid,...}) = uid
217 :     fun gid (ST{gid,...}) = gid
218 :     fun size (ST{size,...}) = size
219 :     fun atime (ST{atime,...}) = atime
220 :     fun mtime (ST{mtime,...}) = mtime
221 :     fun ctime (ST{ctime,...}) = ctime
222 :     end (* structure ST *)
223 :    
224 :     (* this layout needs to track c-libs/posix-filesys/stat.c *)
225 :     type statrep =
226 :     ( s_int (* file type *)
227 :     * word (* mode *)
228 :     * word (* ino *)
229 :     * word (* devno *)
230 :     * word (* nlink *)
231 :     * word (* uid *)
232 :     * word (* gid *)
233 :     * Position.int (* size *)
234 :     * Int32.int (* atime *)
235 :     * Int32.int (* mtime *)
236 :     * Int32.int (* ctime *)
237 :     )
238 :     fun mkStat (sr : statrep) = ST.ST{
239 :     ftype = #1 sr,
240 :     mode = S.MODE (#2 sr),
241 :     ino = INO (#3 sr),
242 :     dev = DEV (#4 sr),
243 :     nlink = SysWord.toInt(#5 sr), (* probably should be an int in
244 :     * the run-time too.
245 :     *)
246 :     uid = UID(#6 sr),
247 :     gid = GID(#7 sr),
248 :     size = #8 sr,
249 :     atime = Time.fromSeconds (#9 sr),
250 :     mtime = Time.fromSeconds (#10 sr),
251 :     ctime = Time.fromSeconds (#11 sr)
252 :     }
253 :    
254 :     val stat' : string -> statrep = cfun "stat"
255 :     val lstat' : string -> statrep = cfun "lstat"
256 :     val fstat' : s_int -> statrep = cfun "fstat"
257 :     fun stat fname = mkStat (stat' fname)
258 :     fun lstat fname = mkStat (lstat' fname) (* POSIX 1003.1a *)
259 :     fun fstat (FD{fd}) = mkStat (fstat' fd)
260 :    
261 :     datatype access_mode = A_READ | A_WRITE | A_EXEC
262 :     val a_read = w_osval "A_READ" (* R_OK *)
263 :     val a_write = w_osval "A_WRITE" (* W_OK *)
264 :     val a_exec = w_osval "A_EXEC" (* X_OK *)
265 :     val a_file = w_osval "A_FILE" (* F_OK *)
266 :     fun amodeToWord [] = a_file
267 :     | amodeToWord l = let
268 :     fun amtoi (A_READ,v) = a_read ++ v
269 :     | amtoi (A_WRITE,v) = a_write ++ v
270 :     | amtoi (A_EXEC,v) = a_exec ++ v
271 :     in
272 :     List.foldl amtoi a_file l
273 :     end
274 :     val access' : string * word -> bool = cfun "access"
275 :     fun access (fname, aml) = access'(fname, amodeToWord aml)
276 :    
277 :     val chmod' : string * word -> unit = cfun "chmod"
278 :     fun chmod (fname, S.MODE m) = chmod'(fname, m)
279 :    
280 :     val fchmod' : s_int * word -> unit = cfun "fchmod"
281 :     fun fchmod (FD{fd}, S.MODE m) = fchmod'(fd, m)
282 :    
283 :     val chown' : string * word * word -> unit = cfun "chown"
284 :     fun chown (fname, UID uid, GID gid) = chown'(fname, uid, gid)
285 :    
286 :     val fchown' : s_int * word * word -> unit = cfun "fchown"
287 :     fun fchown (fd, UID uid, GID gid) = fchown'(intOf fd, uid, gid)
288 :    
289 :     val utime' : string * Int32.int * Int32.int -> unit = cfun "utime"
290 :     fun utime (file, NONE) = utime' (file, ~1, 0)
291 :     | utime (file, SOME{actime, modtime}) = let
292 :     val atime = Time.toSeconds actime
293 :     val mtime = Time.toSeconds modtime
294 :     in
295 :     utime'(file,atime,mtime)
296 :     end
297 :    
298 :     val pathconf : (string * string) -> word option = cfun "pathconf"
299 :     val fpathconf' : (s_int * string) -> word option = cfun "fpathconf"
300 :     fun fpathconf (FD{fd}, s) = fpathconf'(fd, s)
301 :    
302 :     end (* structure POSIX_FileSys *)
303 :    
304 :     (*
305 :     * $Log: posix-filesys.sml,v $
306 : monnier 93 * Revision 1.1.1.1 1998/04/08 18:39:56 george
307 :     * Version 110.5
308 : monnier 16 *
309 :     *)

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