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/branches/SMLNJ/src/compiler/PervEnv/Win32/os-io.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/PervEnv/Win32/os-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 113 - (view) (download)

1 : monnier 113 (* win32-os-io.sml
2 : monnier 16 *
3 : monnier 113 * COPYRIGHT (c) 1998 Bell Labs, Lucent Technologies.
4 : monnier 16 * COPYRIGHT (c) 1996 Bell Laboratories.
5 :     *
6 : monnier 113 * Replacement of OS.IO structure for Win32.
7 :     * It implements a simple type of polling for file objects.
8 : monnier 16 *)
9 :    
10 :     structure OS_IO : OS_IO =
11 :     struct
12 :     structure W32G = Win32_General
13 :     structure W32FS = Win32_FileSys
14 : monnier 113 type word32 = Word32.word
15 : monnier 16
16 :     exception SysErr = Assembly.SysErr
17 :    
18 : monnier 113 type iodesc = OS.IO.iodesc (* IODesc of W32G.hndl ref *)
19 : monnier 16
20 :     (* hash: can't assume 32 bits *)
21 :     fun hash (OS.IO.IODesc (ref (0wxffffffff : W32G.hndl))) =
22 :     0wx7fffffff : word
23 :     | hash (OS.IO.IODesc (ref h)) = (Word.fromInt o W32G.Word.toInt) h
24 :    
25 :     fun compare (OS.IO.IODesc (ref wa),OS.IO.IODesc (ref wb)) =
26 :     W32G.Word.compare(wa,wb)
27 :    
28 :     datatype iodesc_kind = K of string
29 :    
30 :     structure Kind =
31 :     struct
32 :     val file = K "FILE"
33 :     val dir = K "DIR"
34 :     val symlink = K "LINK"
35 :     val tty = K "TTY"
36 :     val pipe = K "PIPE"
37 :     val socket = K "SOCK"
38 :     val device = K "DEV"
39 :     end
40 :    
41 :     fun kind (OS.IO.IODesc (ref h)) =
42 :     case W32FS.getFileAttributes' h of
43 :     NONE =>
44 :     K "UNKNOWN"
45 :     | SOME w =>
46 :     if W32FS.isRegularFile h then Kind.file
47 :     else Kind.dir
48 :    
49 :     (* no win32 polling devices for now *)
50 : monnier 113 val noPolling = "polling not implemented for win32 for this device/type"
51 : monnier 16
52 : monnier 113 datatype poll_desc = PollDesc of iodesc
53 :     datatype poll_info = PollInfo of poll_desc
54 : monnier 16
55 : monnier 113 fun pollDesc id = SOME (PollDesc id) (* NONE *)
56 :     fun pollToIODesc (PollDesc pd) = pd (* raise Fail("pollToIODesc: "^noPolling) *)
57 : monnier 16 exception Poll
58 :    
59 : monnier 113 fun pollIn pd = pd (* raise Fail("pollIn: "^noPolling) *)
60 :     fun pollOut pd = pd (* raise Fail("pollOut: "^noPolling) *)
61 :     fun pollPri pd = pd (* raise Fail("pollPri: "^noPolling) *)
62 : monnier 16
63 : monnier 113 local
64 :     val poll' : (word32 list * (Int32.int * int) option -> word32 list) =
65 :     CInterface.c_function "WIN32-IO" "poll"
66 :     fun toPollInfo (w) = PollInfo (PollDesc (OS.IO.IODesc (ref w)))
67 :     fun fromPollDesc (PollDesc (OS.IO.IODesc (ref w))) = w
68 :     in
69 :     fun poll (pdl,t) =
70 :     let val timeout = (case t
71 :     of SOME (t) => SOME (Time.toSeconds (t),
72 :     Int.fromLarge (Time.toMicroseconds t))
73 :     | NONE => NONE)
74 :     val info = poll' (List.map fromPollDesc pdl,timeout)
75 :     in
76 :     List.map toPollInfo info
77 :     end
78 :     end
79 :    
80 : monnier 16 fun isIn pd = raise Fail("isIn: "^noPolling)
81 :     fun isOut pd = raise Fail("isOut: "^noPolling)
82 :     fun isPri pd = raise Fail("isPri: "^noPolling)
83 :    
84 : monnier 113 fun infoToPollDesc (PollInfo pd) = pd (* raise Fail("infoToPollDesc: "^noPolling) *)
85 : monnier 16 end

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