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/dbm-type-blame/runtime/c-libs/win32-io/poll.c
ViewVC logotype

Annotation of /sml/branches/dbm-type-blame/runtime/c-libs/win32-io/poll.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3594 - (view) (download) (as text)

1 : monnier 249 /* poll.c
2 :     *
3 :     * COPYRIGHT (c) 1998 Bell Laboratories, Lucent Technologies
4 :     *
5 :     * crude implementation of a polling function
6 :     */
7 :    
8 :     #include <windows.h>
9 :    
10 :     #include "ml-base.h"
11 :     #include "ml-values.h"
12 :     #include "ml-objects.h"
13 :     #include "ml-c.h"
14 :    
15 :     #include "win32-fault.h"
16 :    
17 : dbm 3594 /* bit masks for polling descriptors (see src/sml-nj/boot/Unix/os-io.sml) */
18 :     #define RD_BIT 0x1
19 :     #define WR_BIT 0x2
20 :     #define ERR_BIT 0x4
21 : monnier 249
22 : dbm 3594 /* _ml_win32_OS_poll : (word32 * word) list * (int * word) list * (Int32.int * int) option
23 :     * -> (word32 * word) list * (int * word) list
24 : monnier 249 */
25 :     ml_val_t _ml_win32_OS_poll (ml_state_t *msp, ml_val_t arg)
26 :     {
27 :     DWORD dwMilliseconds;
28 :     ml_val_t pollList = REC_SEL(arg,0);
29 : dbm 3594 ml_val_t pollSockList = REC_SEL(arg,1);
30 :     ml_val_t timeout = REC_SEL (arg,2);
31 : monnier 249 int sec,usec;
32 :     ml_val_t l,item;
33 : dbm 3594 ml_val_t hList, sList, resTuple;
34 : monnier 249 HANDLE handle,*hArray;
35 : dbm 3594 fd_set read, write, err;
36 :     int fd, flag;
37 :     struct timeval tv, *tvp;
38 : monnier 249 int result;
39 :    
40 :     int count,index;
41 :    
42 :     /* first, convert timeout to milliseconds */
43 :     if (timeout==OPTION_NONE)
44 :     dwMilliseconds = INFINITE;
45 :     else {
46 :     timeout = OPTION_get(timeout);
47 :     sec = REC_SELINT32(timeout,0);
48 :     usec = REC_SELINT(timeout,1);
49 :     dwMilliseconds = (sec*1000)+(usec/1000);
50 :     }
51 :    
52 :     /* count number of handles */
53 :     for (l=pollList,count=0; l!=LIST_nil; l=LIST_tl(l))
54 :     count++;
55 :    
56 :     /* allocate array of handles */
57 :     hArray = NEW_VEC (HANDLE,count);
58 :    
59 :     /* initialize the array */
60 :     for (l=pollList,index=0; l!=LIST_nil; l=LIST_tl(l)) {
61 :     item = LIST_hd (l);
62 : dbm 3594 handle = (HANDLE) REC_SELWORD(item, 0);
63 : monnier 249 hArray[index++] = handle;
64 :     }
65 :    
66 :     /* generalized poll to see if anything is available */
67 :     result = WaitForMultipleObjects (count,hArray,FALSE,dwMilliseconds);
68 : dbm 3594 hList = LIST_nil;
69 :     if (!((result==WAIT_FAILED)||(result==WAIT_TIMEOUT))) {
70 :     /* at least one handle was ready. Find all that are */
71 :     for (l=pollList; l!=LIST_nil; l=LIST_tl(l)) {
72 :     item = LIST_hd (l);
73 :     handle = (HANDLE) REC_SELWORD(item, 0);
74 :     result = WaitForSingleObject (handle,0);
75 :     if (result==WAIT_FAILED || result==WAIT_TIMEOUT) continue;
76 :     LIST_cons (msp,hList,item,hList);
77 :     }
78 : monnier 249 }
79 :    
80 :     FREE(hArray);
81 :    
82 : dbm 3594 /* SOCKETS */
83 :     /* count number of handles and init the fdsets */
84 :     FD_ZERO(&read);
85 :     FD_ZERO(&write);
86 :     FD_ZERO(&err);
87 :     for (l=pollSockList,count=0; l!=LIST_nil; l=LIST_tl(l)) {
88 :     count++;
89 :     item = LIST_hd (l);
90 :     fd = REC_SELINT(item, 0);
91 :     flag = REC_SELINT(item, 1);
92 :     if ((flag & RD_BIT) != 0) {
93 :     FD_SET(fd,&read);
94 :     }
95 :     if ((flag & WR_BIT) != 0) {
96 :     FD_SET(fd,&write);
97 :     }
98 :     if ((flag & ERR_BIT) != 0) {
99 :     FD_SET(fd,&err);
100 :     }
101 :     }
102 :    
103 :     if (timeout == OPTION_NONE) {
104 :     tvp = NIL(struct timeval *);
105 :     } else {
106 :     tv.tv_sec = REC_SELINT32(timeout, 0);
107 :     tv.tv_usec = REC_SELINT(timeout, 1);
108 :     tvp = &tv;
109 :     }
110 :    
111 :     sList = LIST_nil;
112 :    
113 :     if (count > 0) {
114 :     result = select (count, &read, &write, &err, tvp);
115 :     if (result < 0)
116 :     return RAISE_SYSERR(msp, sts);
117 :     else if (result > 0) {
118 :     ml_val_t *resVec = NEW_VEC(ml_val_t, result);
119 :     int i, resFlag;
120 :    
121 :     for (i = 0, l = pollSockList; l != LIST_nil; l = LIST_tl(l)) {
122 :     item = LIST_hd(l);
123 :     fd = REC_SELINT(item, 0);
124 :     flag = REC_SELINT(item, 1);
125 :     resFlag = 0;
126 :     if (((flag & RD_BIT) != 0) && FD_ISSET(fd, &read))
127 :     resFlag |= RD_BIT;
128 :     if (((flag & WR_BIT) != 0) && FD_ISSET(fd, &write))
129 :     resFlag |= WR_BIT;
130 :     if (((flag & ERR_BIT) != 0) && FD_ISSET(fd, &err))
131 :     resFlag |= ERR_BIT;
132 :     if (resFlag != 0) {
133 :     REC_ALLOC2 (msp, item, INT_CtoML(fd), INT_CtoML(resFlag));
134 :     resVec[i++] = item;
135 :     }
136 :     }
137 :    
138 :     ASSERT(i == result);
139 :    
140 :     for (i = result-1, sList = LIST_nil; i >= 0; i--) {
141 :     item = resVec[i];
142 :     LIST_cons (msp, sList, item, sList);
143 :     }
144 :    
145 :     FREE(resVec);
146 :     }
147 :     }
148 :    
149 :    
150 :     REC_ALLOC2(msp, resTuple, hList, sList)
151 :     return resTuple;
152 :     }
153 :    
154 :    
155 : monnier 249 /* end of poll.c */
156 :    
157 :    
158 :    
159 :    
160 :    
161 :    
162 :    

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