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/os-io.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 144 - (view) (download)

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

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