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/dbm-type-blame/system/Basis/Implementation/Win32/os-io.sml
ViewVC logotype

Diff of /sml/branches/dbm-type-blame/system/Basis/Implementation/Win32/os-io.sml

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

revision 3593, Wed May 11 03:44:12 2011 UTC revision 3594, Thu May 12 16:06:32 2011 UTC
# Line 70  Line 70 
70          fun pollPri (PollDesc (iod,{rd,wr,pri})) = PollDesc (iod,{rd=rd,wr=wr,pri=true})          fun pollPri (PollDesc (iod,{rd,wr,pri})) = PollDesc (iod,{rd=rd,wr=wr,pri=true})
71    
72          local          local
73              val poll' : (word32 list * (int * word) list * (Int32.int * int) option -> (word32 list * (int * word) list)) =              val poll' : ((word32 * word) list * (int * word) list * (Int32.int * int) option -> ((word32 * word) list * (int * word) list)) =
74                  CInterface.c_function "WIN32-IO" "poll"                  CInterface.c_function "WIN32-IO" "poll"
75    
76              fun join (false, _, w) = w              fun join (false, _, w) = w
# Line 78  Line 78 
78              fun test (w, b) = (Word.andb(w, b) <> 0w0)              fun test (w, b) = (Word.andb(w, b) <> 0w0)
79              val rdBit = 0w1 and wrBit = 0w2 and priBit = 0w4              val rdBit = 0w1 and wrBit = 0w2 and priBit = 0w4
80    
81              fun toPollInfoIO (fd) = PollInfo (PollDesc (OS.IO.IODesc (ref fd),{rd=false,wr=false,pri=false}))              fun toPollInfoIO (fd,w) = PollInfo (PollDesc (OS.IO.IODesc (ref fd),{rd= test(w,rdBit),
82                                                                                   wr= test(w,wrBit),
83                                                                                   pri= test(w,priBit)}))
84              fun toPollInfoSock (i,w) = PollInfo (PollDesc (OS.IO.SockDesc (i),{rd = test(w,rdBit),              fun toPollInfoSock (i,w) = PollInfo (PollDesc (OS.IO.SockDesc (i),{rd = test(w,rdBit),
85                                                                                 wr = test(w,wrBit),                                                                                 wr = test(w,wrBit),
86                                                                                 pri = test(w,priBit)}))                                                                                 pri = test(w,priBit)}))
87              fun fromPollDescIO (PollDesc (OS.IO.IODesc (ref w),_)) =SOME (w)              fun fromPollDescIO (PollDesc (OS.IO.IODesc (ref w),{rd,wr,pri})) =(w,join (rd,rdBit, join (wr,wrBit, join (pri,priBit,0w0))))
88                | fromPollDescIO _ = NONE              fun fromPollDescSock (PollDesc (OS.IO.SockDesc (i),{rd,wr,pri})) = (i,join (rd,rdBit, join (wr,wrBit, join (pri,priBit,0w0))))
89              fun fromPollDescSock (PollDesc (OS.IO.SockDesc (i),{rd,wr,pri})) = SOME (i,join (rd,rdBit, join (wr,wrBit, join (pri,priBit,0w0))))  
90                | fromPollDescSock _ = NONE              (* To preserve equality, return the original PollDesc passed to poll.
91                 * This is cheesy, but restructuring the IODesc to no longer have a ref
92                 * cell is a substantial amount of work, as much of the Win32 FS basis
93                 * relies on mutability.
94                 *)
95                fun findPollDescFromIO (pollIOs, (fd,w)) = let
96                    val desc = List.find (fn (PollDesc (OS.IO.IODesc (ref fd'),_)) => fd'=fd) pollIOs
97                in
98                    case desc
99                     of SOME f => SOME(PollInfo f)
100                      | NONE => NONE
101                end
102          in          in
103              fun poll (pdl,t) =              fun poll (pdl,t) =
104                  let val timeout =                  let val timeout =
# Line 94  Line 107 
107                              SOME (Int32.fromLarge (Time.toSeconds (t)),                              SOME (Int32.fromLarge (Time.toSeconds (t)),
108                                    Int.fromLarge (Time.toMicroseconds t))                                    Int.fromLarge (Time.toMicroseconds t))
109                            | NONE => NONE                            | NONE => NONE
110                        fun partDesc (PollDesc (OS.IO.IODesc (_),_)) = true
111                          | partDesc (_) = false
112                        val (pollIOs, pollSocks) = List.partition partDesc pdl
113                      val (infoIO,infoSock) =                      val (infoIO,infoSock) =
114                          poll' (List.mapPartial fromPollDescIO pdl,                          poll' (List.map fromPollDescIO pollIOs,
115                                 List.mapPartial fromPollDescSock pdl,                                 List.map fromPollDescSock pollSocks,
116                                 timeout)                                 timeout)
117                  in                  in
118                      List.@ (List.map toPollInfoIO infoIO,                      List.@ (List.mapPartial (fn (p) => findPollDescFromIO(pollIOs,p)) infoIO,
119                              List.map toPollInfoSock infoSock)                              List.map toPollInfoSock infoSock)
120                  end                  end
121          end          end
122    
123          fun isIn pd = raise Fail("isIn: "^noPolling)          fun isIn (PollInfo(PollDesc(_, flgs))) = #rd flgs
124          fun isOut pd = raise Fail("isOut: "^noPolling)          fun isOut (PollInfo(PollDesc(_, flgs))) = #wr flgs
125          fun isPri pd = raise Fail("isPri: "^noPolling)          fun isPri (PollInfo(PollDesc(_, flgs))) = #pri flgs
126            fun infoToPollDesc (PollInfo pd) = pd
         fun infoToPollDesc (PollInfo pd) = pd (* raise Fail("infoToPollDesc: "^noPolling) *)  
127      end      end
128  end  end
129    

Legend:
Removed from v.3593  
changed lines
  Added in v.3594

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