PVT ml_val_t ptrlist_to_MLlist(ml_state_t *msp)
{
ml_val_t lp = LIST_nil;
ml_val_t v;
ptrlist_t *p;
#ifdef DEBUG_C_CALLS
int i = 0;
SayDebug("converting ptrlist (|ptrlist|=%d) to ML list ",ptrlist_len());
#endif
p = ptrlist;
while (p != NULL) {
#ifdef DEBUG_C_CALLS
i++;
#endif
ptrlist = p->next;
v = MK_CADDR(msp,p->ptr);
LIST_cons(msp, lp, v, lp);
FREE(p);
p = ptrlist;
}
#ifdef DEBUG_C_CALLS
SayDebug("of length %d\n", i);
#endif
return lp;
}
/* RaiseSysError:
*
* Raise the Lib7 exception SysErr, which has the spec:
*
* exception SYSTEM_ERROR of (String * System_Error Null_Or)
*
* We use the last win32-api error value as the System_Error; eventually that
* will be represented by an (int * String) pair. If alt_msg is non-zero,
* then use it as the error string and use NULL for the System_Error.
*/
lib7_val_t RaiseSysError (lib7_state_t *lib7_state, const char *altMsg, char *at)
{
lib7_val_t s, syserror, arg, exn, atStk;
const char *msg;
char buf[32];
int errno = -1;
if (altMsg != NULL) {
msg = altMsg;
syserror = OPTION_NONE;
}
else {
errno = (int) GetLastError();
sprintf(buf, "<win32 error code %d>", errno);
msg = buf;
OPTION_SOME(lib7_state, syserror, INT_CtoLib7(errno));
}
s = LIB7_CString (lib7_state, msg);
if (at != NULL) {
lib7_val_t atMsg = LIB7_CString (lib7_state, at);
LIST_cons(lib7_state, atStk, atMsg, LIST_nil);
}
else
atStk = LIST_nil;
REC_ALLOC2 (lib7_state, arg, s, syserror);
EXN_ALLOC (lib7_state, exn, PTR_CtoLib7(SysErrId), arg, atStk);
RaiseLib7Exception (lib7_state, exn);
return exn;
} /* end of RaiseSysError */
/* _util_NetDB_mkhostent:
*
* Allocate an Lib7 value of type
* (String * String list * addr_family * addr list) option
* to represent a struct hostent value.
*
* NOTE: we should probably be passing back the value of h_errno, but this
* will require an API change at the Lib7 level. XXX BUGGO FIXME
*/
lib7_val_t _util_NetDB_mkhostent (lib7_state_t *lib7_state, struct hostent *hentry)
{
if (hentry == NULL)
return OPTION_NONE;
else {
/* build the return result */
lib7_val_t name, aliases, af, addr, addresses, res;
int nAddresses, i;
name = LIB7_CString(lib7_state, hentry->h_name);
aliases = LIB7_CStringList(lib7_state, hentry->h_aliases);
af = LIB7_SysConst (lib7_state, &_Sock_AddrFamily, hentry->h_addrtype);
for (nAddresses = 0; hentry->h_addr_list[nAddresses] != NULL; nAddresses++)
continue;
for (i = nAddresses, addresses = LIST_nil; --i >= 0; ) {
addr = LIB7_AllocString (lib7_state, hentry->h_length);
memcpy (GET_SEQ_DATAPTR(void, addr), hentry->h_addr_list[i],
hentry->h_length);
LIST_cons(lib7_state, addresses, addr, addresses);
}
REC_ALLOC4 (lib7_state, res, name, aliases, af, addresses);
OPTION_SOME (lib7_state, res, res);
return res;
}
} /* end of _util_NetDB_mkhostent */
/* 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;
}
}
}
/* 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 */