Val _lib7_P_ProcEnv_getgroups (Task* task, Val arg) {
//=========================
//
// Mythryl type: Void -> List(Int)
//
// Return supplementary group access list ids.
//
// This fn gets bound as get_group_ids in:
//
// src/lib/std/src/posix-1003.1b/posix-id.pkg
gid gidset[ NGROUPS_MAX ];
Val result;
int ngrps = getgroups( NGROUPS_MAX, gidset );
if (ngrps != -1) {
//
result = mkList (task, ngrps, gidset);
} else {
gid* gp;
// If the error was not due to too small buffer size,
// raise exception.
//
if (errno != EINVAL) return RAISE_SYSERR(task, -1);
// Find out how many groups there
// are and allocate enough space:
//
ngrps = getgroups( 0, gidset );
//
gp = (gid*) MALLOC( ngrps * (sizeof (gid)) );
//
if (gp == 0) {
errno = ENOMEM;
return RAISE_SYSERR(task, -1);
}
ngrps = getgroups (ngrps, gp);
if (ngrps == -1) result = RAISE_SYSERR(task, -1);
else result = mkList (task, ngrps, gp);
FREE ((void *)gp);
}
return result;
}
/* _ml_P_Process_waitpid : int * word -> int * int * int
*
* Wait for child processes to stop or terminate
*/
ml_val_t _ml_P_Process_waitpid (ml_state_t *msp, ml_val_t arg)
{
int pid;
int status, how, val;
ml_val_t r;
pid = waitpid(REC_SELINT(arg, 0), &status, REC_SELWORD(arg, 1));
if (pid < 0)
return RAISE_SYSERR(msp, pid);
if (WIFEXITED(status)) {
how = 0;
val = WEXITSTATUS(status);
}
else if (WIFSIGNALED(status)) {
how = 1;
val = WTERMSIG(status);
}
else if (WIFSTOPPED(status)) {
how = 2;
val = WSTOPSIG(status);
}
else
return RAISE_ERROR(msp, "unknown child status");
REC_ALLOC3(msp, r, INT_CtoML(pid), INT_CtoML(how), INT_CtoML(val));
return r;
} /* end of _ml_P_Process_waitpid */
/* _lib7_Sock_recvbuffrom
* : (socket * rw_unt8_vector.Rw_Vector * int * int * Bool * Bool) -> (int * addr)
*
* The arguments are: socket, data buffer, start position, number of
* bytes, OOB flag and peek flag. The result is number of bytes read and
* the source address.
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/socket-guts.pkg
*/
lib7_val_t _lib7_Sock_recvbuffrom (lib7_state_t *lib7_state, lib7_val_t arg)
{
char addrBuf[MAX_SOCK_ADDR_SZB];
int addrLen = MAX_SOCK_ADDR_SZB;
int socket = REC_SELINT(arg, 0);
lib7_val_t buf = REC_SEL(arg, 1);
int nbytes = REC_SELINT(arg, 3);
char *start = STR_LIB7toC(buf) + REC_SELINT(arg, 2);
int flag = 0;
int n;
if (REC_SEL(arg, 4) == LIB7_true) flag |= MSG_OOB;
if (REC_SEL(arg, 5) == LIB7_true) flag |= MSG_PEEK;
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
n = recvfrom (socket, start, nbytes, flag, (struct sockaddr *)addrBuf, &addrLen);
/* } while (n < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
if (n < 0)
return RAISE_SYSERR(lib7_state, status);
else {
lib7_val_t data = LIB7_CData (lib7_state, addrBuf, addrLen);
lib7_val_t addr, res;
SEQHDR_ALLOC (lib7_state, addr, DESC_word8vec, data, addrLen);
REC_ALLOC2(lib7_state, res, INT_CtoLib7(n), addr);
return res;
}
} /* end of _lib7_Sock_recvbuffrom */
Val _lib7_P_SysDB_getgrnam (Task* task, Val arg) {
//======================
//
// Mythryl type: String -> (String, Unt, List(String))
//
// Get group file entry by name.
//
// This fn gets bound as getgrname' in:
//
// src/lib/std/src/posix-1003.1b/posix-etc.pkg
struct group* info = getgrnam( HEAP_STRING_AS_C_STRING( arg ));
if (info == NULL) return RAISE_SYSERR(task, -1);
Val gr_name = make_ascii_string_from_c_string( task, info->gr_name );
Val gr_gid;
WORD_ALLOC (task, gr_gid, (Val_Sized_Unt)(info->gr_gid));
Val gr_mem = make_ascii_strings_from_vector_of_c_strings( task, info->gr_mem );
Val result;
REC_ALLOC3(task, result, gr_name, gr_gid, gr_mem);
return result;
}
/* _lib7_Sock_getNREAD : socket -> int
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/socket-guts.pkg
*/
lib7_val_t _lib7_Sock_getNREAD (lib7_state_t *lib7_state, lib7_val_t arg)
{
int n, status;
status = ioctl (INT_LIB7toC(arg), FIONREAD, (char *)&n);
if (status < 0)
return RAISE_SYSERR(lib7_state, status);
else
return INT_CtoLib7(n);
} /* end of _lib7_Sock_getNREAD */
Val _lib7_P_ProcEnv_sysconf (Task* task, Val arg) {
//=======================
//
// Mythryl type: String -> Unt
//
// Get configurable system variables
//
// This fn gets bound as sysconf in:
//
// src/lib/std/src/posix-1003.1b/posix-process.pkg
name_val_t* attribute = _lib7_posix_nv_lookup(HEAP_STRING_AS_C_STRING(arg), values, NUMELMS);
//
if (!attribute) {
//
errno = EINVAL;
return RAISE_SYSERR(task, -1);
}
long val;
errno = 0;
//
while (((val = sysconf(attribute->val)) == -1) && (errno == EINTR)) {
errno = 0;
continue;
}
if (val >= 0) {
//
Val result;
WORD_ALLOC (task, result, val);
return result;
}
if (errno == 0) return RAISE_ERROR(task, "unsupported POSIX feature");
else return RAISE_SYSERR(task, -1);
}
/* _lib7_win32_IO_close: one_word_unt -> Void
* close a handle
*/
Val _lib7_win32_IO_close(Task *task, Val arg)
{
HANDLE h = (HANDLE) WORD_LIB7toC(arg);
if (CloseHandle(h)) {
return HEAP_VOID;
}
#ifdef WIN32_DEBUG
debug_say("_lib7_win32_IO_close: failing\n");
#endif
return RAISE_SYSERR(task,-1);
}
Val _lib7_P_Process_waitpid (Task* task, Val arg) {
//=======================
//
// Mythryl type: (Int, Unt) -> (Int, Int, Int)
//
// Wait for child processes to stop or terminate.
//
// This fn gets bound as waitpid' in:
//
// src/lib/std/src/posix-1003.1b/posix-process.pkg
int status;
int how;
int val;
int pid;
/* do { */ // Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c
pid = waitpid(GET_TUPLE_SLOT_AS_INT(arg, 0), &status, TUPLE_GETWORD(arg, 1));
/* } while (pid < 0 && errno == EINTR); */ // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
if (pid < 0) return RAISE_SYSERR(task, pid);
if (WIFEXITED(status)) {
//
how = 0;
val = WEXITSTATUS(status);
} else if (WIFSIGNALED(status)) {
how = 1;
val = WTERMSIG(status);
} else if (WIFSTOPPED(status)) {
how = 2;
val = WSTOPSIG(status);
} else {
return RAISE_ERROR(task, "unknown child status");
}
Val result;
REC_ALLOC3(task, result, TAGGED_INT_FROM_C_INT(pid), TAGGED_INT_FROM_C_INT(how), TAGGED_INT_FROM_C_INT(val));
return result;
}
/* _lib7_Sock_recv : (Socket, Int, Bool, Bool) -> unt8_vector::Vector
*
* The arguments are: socket, number of bytes, OOB flag and peek flag; the
* result is the vector of bytes received.
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/socket-guts.pkg
*/
lib7_val_t _lib7_Sock_recv (lib7_state_t *lib7_state, lib7_val_t arg)
{
lib7_val_t vec;
lib7_val_t result;
int n;
int socket = REC_SELINT(arg, 0);
int nbytes = REC_SELINT(arg, 1);
lib7_val_t oob = REC_SEL( arg, 2);
lib7_val_t peek = REC_SEL( arg, 3);
int flag = 0;
if (oob == LIB7_true) flag |= MSG_OOB;
if (peek == LIB7_true) flag |= MSG_PEEK;
/* Allocate the vector.
* Note that this might cause a GC:
*/
vec = LIB7_AllocRaw32 (lib7_state, BYTES_TO_WORDS(nbytes));
print_if("recv.c/before: socket d=%d nbytes d=%d oob=%s peek=%s\n",socket,nbytes,(oob == LIB7_true)?"TRUE":"FALSE",(peek == LIB7_true)?"TRUE":"FALSE");
errno = 0;
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
n = recv (socket, PTR_LIB7toC(char, vec), nbytes, flag);
/* } while (n < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
print_if( "recv.c/after: n d=%d errno d=%d (%s)\n", n, errno, errno ? strerror(errno) : "");
hexdump_if( "recv.c/after: Received data: ", PTR_LIB7toC(unsigned char, vec), n );
if (n < 0)
return RAISE_SYSERR(lib7_state, status);
else if (n == 0)
return LIB7_string0;
if (n < nbytes) {
/* we need to shrink the vector */
LIB7_ShrinkRaw32 (lib7_state, vec, BYTES_TO_WORDS(n));
}
SEQHDR_ALLOC (lib7_state, result, DESC_string, vec, n);
return result;
}
/* _lib7_win32_PS_get_environment_variable : String -> String option
* var
*
*/
Val _lib7_win32_PS_get_environment_variable(Task *task, Val arg)
{
#define GEV_BUF_SZ 4096
char buf[GEV_BUF_SZ];
int ret = GetEnvironmentVariable(HEAP_STRING_AS_C_STRING(arg),buf,GEV_BUF_SZ);
Val ml_s,res = OPTION_NULL;
if (ret > GEV_BUF_SZ) {
return RAISE_SYSERR(task,-1);
}
if (ret > 0) {
ml_s = make_ascii_string_from_c_string(task,buf);
OPTION_THE(task,res,ml_s);
}
return res;
#undef GEV_BUF_SZ
}
/* _lib7_win32_PS_get_environment_variable : String -> String option
* var
*
*/
lib7_val_t _lib7_win32_PS_get_environment_variable(lib7_state_t *lib7_state, lib7_val_t arg)
{
#define GEV_BUF_SZ 4096
char buf[GEV_BUF_SZ];
int ret = GetEnvironmentVariable(STR_LIB7toC(arg),buf,GEV_BUF_SZ);
lib7_val_t ml_s,res = OPTION_NONE;
if (ret > GEV_BUF_SZ) {
return RAISE_SYSERR(lib7_state,-1);
}
if (ret > 0) {
ml_s = LIB7_CString(lib7_state,buf);
OPTION_SOME(lib7_state,res,ml_s);
}
return res;
#undef GEV_BUF_SZ
}
/* _ml_Sock_getsockname : sock -> addr
*/
ml_val_t _ml_Sock_getsockname (ml_state_t *msp, ml_val_t arg)
{
int sock = INT_MLtoC(arg);
char addrBuf[MAX_SOCK_ADDR_SZB];
socklen_t addrLen = MAX_SOCK_ADDR_SZB;
int sts;
sts = getsockname (sock, (struct sockaddr *)addrBuf, &addrLen);
if (sts == -1)
return RAISE_SYSERR(msp, sts);
else {
ml_val_t data = ML_CData (msp, addrBuf, addrLen);
ml_val_t addr;
SEQHDR_ALLOC (msp, addr, DESC_word8vec, data, addrLen);
return addr;
}
} /* end of _ml_Sock_getsockname */
/* _ml_Sock_ctlRCVBUF : (sock * int option) -> int
*/
ml_val_t _ml_Sock_ctlRCVBUF (ml_state_t *msp, ml_val_t arg)
{
int sock = REC_SELINT(arg, 0);
ml_val_t ctl = REC_SEL(arg, 1);
int sz, sts;
if (ctl == OPTION_NONE) {
socklen_t optSz = sizeof(int);
sts = getsockopt (sock, SOL_SOCKET, SO_RCVBUF, (sockoptval_t)&sz, &optSz);
ASSERT((sts < 0) || (optSz == sizeof(int)));
}
else {
sz = INT_MLtoC(OPTION_get(ctl));
sts = setsockopt (sock, SOL_SOCKET, SO_RCVBUF, (sockoptval_t)&sz, sizeof(int));
}
if (sts < 0)
return RAISE_SYSERR(msp, sts);
else
return INT_CtoML(sz);
} /* end of _ml_Sock_ctlRCVBUF */
Val _lib7_P_FileSys_readdir (Task* task, Val arg) {
//=======================
//
// Mythryl type: Ckit_Dirstream -> String
//
// Return the next filename from the directory stream.
//
// This fn gets bound as readdir' in:
//
// src/lib/std/src/posix-1003.1b/posix-file.pkg
// src/lib/std/src/posix-1003.1b/posix-file-system-64.pkg
struct dirent* dirent;
while (TRUE) {
errno = 0;
dirent = readdir(PTR_CAST(DIR*, arg));
if (dirent == NULL) {
if (errno != 0) return RAISE_SYSERR(task, -1); // Error occurred.
else return ZERO_LENGTH_STRING__GLOBAL; // End of stream.
} else {
char *cp = dirent->d_name;
// SML/NJ drops "." and ".." at this point,
// but that is alien to posix culture,
// so I've commented it out: -- 2008-02-23 CrT
//
// if ((cp[0] == '.')
// && ((cp[1] == '\0') || ((cp[1] == '.') && (cp[2] == '\0'))))
// continue;
// else
//
return make_ascii_string_from_c_string (task, cp);
}
}
}
/* _lib7_Sock_socketpair : (int * int * int) -> (socket * socket)
*
* Create a pair of sockets. The arguments are: domain (should be
* AF_UNIX), type, and protocol.
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/generic-socket.pkg
*/
lib7_val_t _lib7_Sock_socketpair (lib7_state_t *lib7_state, lib7_val_t arg)
{
int domain = REC_SELINT(arg, 0);
int type = REC_SELINT(arg, 1);
int protocol = REC_SELINT(arg, 2);
int status;
int socket[2];
status = socketpair (domain, type, protocol, socket);
if (status < 0) {
return RAISE_SYSERR(lib7_state, status);
} else {
lib7_val_t res;
REC_ALLOC2(lib7_state, res, INT_CtoLib7(socket[0]), INT_CtoLib7(socket[1]));
return res;
}
} /* end of _lib7_Sock_socketpair */
/* _lib7_Sock_ctlNODELAY : (socket * Bool option) -> Bool
*
* NOTE: this is a TCP level option, so we cannot use the utility function.
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/internet-socket.pkg
*/
lib7_val_t _lib7_Sock_ctlNODELAY (lib7_state_t *lib7_state, lib7_val_t arg)
{
int socket = REC_SELINT(arg, 0);
lib7_val_t ctl = REC_SEL(arg, 1);
bool_t flag;
int status;
if (ctl == OPTION_NONE) {
int optSz = sizeof(int);
status = getsockopt (socket, IPPROTO_TCP, TCP_NODELAY, (sockoptval_t)&flag, &optSz);
ASSERT((status < 0) || (optSz == sizeof(int)));
}
else {
flag = (bool_t)INT_LIB7toC(OPTION_get(ctl));
status = setsockopt (socket, IPPROTO_TCP, TCP_NODELAY, (sockoptval_t)&flag, sizeof(int));
}
if (status < 0)
return RAISE_SYSERR(lib7_state, status);
else
return (flag ? LIB7_true : LIB7_false);
} /* end of _lib7_Sock_ctlNODELAY */
/* _ml_Date_localtime : Int32.int -> (int * int * int * int * int * int * int * int * int)
*
* Takes a local time value (in seconds), and converts it to a 9-tuple with
* the fields: tm_sec, tm_min, tm_hour, tm_mday, tm_mon, tm_year, tm_wday,
* tm_yday, and tm_isdst.
*/
ml_val_t _ml_Date_localtime (ml_state_t *msp, ml_val_t arg)
{
time_t t = (time_t)INT32_MLtoC(arg);
struct tm *tm;
tm = localtime (&t);
if (tm == NULL) RAISE_SYSERR(msp,0);
ML_AllocWrite(msp, 0, MAKE_DESC(DTAG_record, 9));
ML_AllocWrite(msp, 1, INT_CtoML(tm->tm_sec));
ML_AllocWrite(msp, 2, INT_CtoML(tm->tm_min));
ML_AllocWrite(msp, 3, INT_CtoML(tm->tm_hour));
ML_AllocWrite(msp, 4, INT_CtoML(tm->tm_mday));
ML_AllocWrite(msp, 5, INT_CtoML(tm->tm_mon));
ML_AllocWrite(msp, 6, INT_CtoML(tm->tm_year));
ML_AllocWrite(msp, 7, INT_CtoML(tm->tm_wday));
ML_AllocWrite(msp, 8, INT_CtoML(tm->tm_yday));
ML_AllocWrite(msp, 9, INT_CtoML(tm->tm_isdst));
return ML_Alloc(msp, 9);
} /* end of _ml_Date_localtime */
/* _lib7_Sock_accept : Socket -> (Socket, Address)
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/socket-guts.pkg
*/
lib7_val_t _lib7_Sock_accept (lib7_state_t *lib7_state, lib7_val_t arg)
{
int socket = INT_LIB7toC(arg);
char addrBuf[MAX_SOCK_ADDR_SZB];
int addrLen = MAX_SOCK_ADDR_SZB;
int newSock;
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
newSock = accept (socket, (struct sockaddr *)addrBuf, &addrLen);
/* } while (newSock < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
if (newSock == -1) {
return RAISE_SYSERR(lib7_state, newSock);
} else {
lib7_val_t data = LIB7_CData (lib7_state, addrBuf, addrLen);
lib7_val_t addr, res;
SEQHDR_ALLOC(lib7_state, addr, DESC_word8vec, data, addrLen);
REC_ALLOC2(lib7_state, res, INT_CtoLib7(newSock), addr);
return res;
}
}
/* LIB7_Poll:
*
* The version of the polling operation for systems that provide BSD select.
*/
static lib7_val_t LIB7_Poll (lib7_state_t *lib7_state, lib7_val_t poll_list, struct timeval *timeout)
{
fd_set rset, wset, eset;
fd_set *rfds, *wfds, *efds;
int maxFD, status, fd, flag;
lib7_val_t l, item;
/*printf("src/runtime/c-libs/posix-os/poll.c: Using 'select' implementation\n");*/
rfds = wfds = efds = NULL;
maxFD = 0;
for (l = poll_list; l != LIST_nil; l = LIST_tl(l)) {
item = LIST_hd(l);
fd = REC_SELINT(item, 0);
flag = REC_SELINT(item, 1);
if ((flag & READABLE_BIT) != 0) {
/*int fd_flags = fcntl(fd,F_GETFL,0);*/
if (rfds == NULL) {
rfds = &rset;
FD_ZERO(rfds);
}
/*printf("src/runtime/c-libs/posix-os/poll.c: Will check fd %d for readability. fd flags x=%x O_NONBLOCK x=%x\n",fd,fd_flags,O_NONBLOCK);*/
FD_SET (fd, rfds);
}
if ((flag & WRITABLE_BIT) != 0) {
if (wfds == NULL) {
wfds = &wset;
FD_ZERO(wfds);
}
/*printf("src/runtime/c-libs/posix-os/poll.c: Will check fd %d for writability.\n",fd);*/
FD_SET (fd, wfds);
}
if ((flag & OOBDABLE_BIT) != 0) {
if (efds == NULL) {
efds = &eset;
FD_ZERO(efds);
}
/*printf("src/runtime/c-libs/posix-os/poll.c: Will check fd %d for oobdability.\n",fd);*/
FD_SET (fd, efds);
}
if (fd > maxFD) maxFD = fd;
}
/*printf("src/runtime/c-libs/posix-os/poll.c: maxFD d=%d timeout x=%x.\n",maxFD,timeout);*/
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
status = select (maxFD+1, rfds, wfds, efds, timeout);
/* } while (status < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
/*printf("src/runtime/c-libs/posix-os/poll.c: result status d=%d.\n",status);*/
if (status < 0)
return RAISE_SYSERR(lib7_state, status);
else if (status == 0)
return LIST_nil;
else {
lib7_val_t *resVec = NEW_VEC(lib7_val_t, status);
int i;
int resFlag;
for (i = 0, l = poll_list; l != LIST_nil; l = LIST_tl(l)) {
item = LIST_hd(l);
fd = REC_SELINT(item, 0);
flag = REC_SELINT(item, 1);
resFlag = 0;
if (((flag & READABLE_BIT) != 0) && FD_ISSET(fd, rfds)) {
/*int fd_flags = fcntl(fd,F_GETFL,0);*/
/*printf("src/runtime/c-libs/posix-os/poll.c: fd d=%d is in fact readable. fd flags x=%x O_NONBLOCK x=%x\n",fd,fd_flags,O_NONBLOCK);*/
resFlag |= READABLE_BIT;
}
if (((flag & WRITABLE_BIT) != 0) && FD_ISSET(fd, wfds)) {
/*printf("src/runtime/c-libs/posix-os/poll.c: fd d=%d is in fact writable.\n",fd);*/
resFlag |= WRITABLE_BIT;
}
if (((flag & OOBDABLE_BIT) != 0) && FD_ISSET(fd, efds)) {
/*printf("src/runtime/c-libs/posix-os/poll.c: fd d=%d is in fact oobdable.\n",fd);*/
resFlag |= OOBDABLE_BIT;
}
if (resFlag != 0) {
REC_ALLOC2 (lib7_state, item, INT_CtoLib7(fd), INT_CtoLib7(resFlag));
resVec[i++] = item;
}
}
ASSERT(i == status);
for (i = status-1, l = LIST_nil; i >= 0; i--) {
item = resVec[i];
LIST_cons (lib7_state, l, item, l);
}
FREE(resVec);
return l;
}
} /* end of LIB7_Poll */
/* LIB7_Poll:
*
* The version of the polling operation for systems that provide SVR4 polling.
*/
static lib7_val_t LIB7_Poll (lib7_state_t *lib7_state, lib7_val_t poll_list, struct timeval *timeout)
{
int tout;
struct pollfd* fds;
struct pollfd* fdp;
int nfds, i, flag;
lib7_val_t l, item;
if (timeout == NULL)
tout = -1;
else
/* Convert to miliseconds: */
tout = (timeout->tv_sec * 1000) + (timeout->tv_usec / 1000);
/* Count the number of polling items:
*/
for (l = poll_list, nfds = 0; l != LIST_nil; l = LIST_tl(l))
nfds++;
/* Allocate the fds vector: */
fds = NEW_VEC(struct pollfd, nfds);
CLEAR_MEM (fds, sizeof(struct pollfd)*nfds);
/* Initialize the polling descriptors:
*/
for (l = poll_list, fdp = fds; l != LIST_nil; l = LIST_tl(l), fdp++) {
item = LIST_hd(l);
fdp->fd = REC_SELINT(item, 0);
flag = REC_SELINT(item, 1);
if ((flag & READABLE_BIT) != 0) fdp->events |= POLLIN;
if ((flag & WRITABLE_BIT) != 0) fdp->events |= POLLOUT;
if ((flag & OOBDABLE_BIT) != 0) fdp->events |= POLL_ERROR;
}
{ int status;
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
status = poll (fds, nfds, tout);
/* } while (status < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
if (status < 0) {
FREE(fds);
return RAISE_SYSERR(lib7_state, status);
}
else {
for (i = nfds-1, l = LIST_nil; i >= 0; i--) {
fdp = &(fds[i]);
if (fdp->revents != 0) {
flag = 0;
if ((fdp->revents & POLLIN ) != 0) flag |= READABLE_BIT;
if ((fdp->revents & POLLOUT ) != 0) flag |= WRITABLE_BIT;
if ((fdp->revents & POLL_ERROR) != 0) flag |= OOBDABLE_BIT;
REC_ALLOC2(lib7_state, item, INT_CtoLib7(fdp->fd), INT_CtoLib7(flag));
LIST_cons(lib7_state, l, item, l);
}
}
FREE(fds);
return l;
}
}
}