/* _lib7_Math_ctlrndmode : int option -> int
*
* Get/set the rounding mode; the values are interpreted as follows:
*
* 0 To nearest
* 1 To zero
* 2 To +Inf
* 3 To -Inf
*/
lib7_val_t _lib7_Math_ctlrndmode (lib7_state_t *lib7_state, lib7_val_t arg)
{
#ifdef NO_ROUNDING_MODE_CTL
return RAISE_ERROR(lib7_state, "Rounding mode control not supported");
#else
if (arg == OPTION_NONE) {
fe_rnd_mode_t res = fegetround();
return RMODE_CtoLib7(res);
}
else {
fe_rnd_mode_t m = RMODE_LIB7toC(OPTION_get(arg));
fe_rnd_mode_t res = fesetround(m);
return RMODE_CtoLib7(res);
}
#endif
} /* end of _lib7_Math_ctlrndmode */
/* _lib7_OS_poll : (List (Int, Unt), Null_Or(int32.Int, Int)) -> List (Int, Unt)
*/
lib7_val_t _lib7_OS_poll (lib7_state_t *lib7_state, lib7_val_t arg)
{
lib7_val_t poll_list = REC_SEL(arg, 0);
lib7_val_t timeout = REC_SEL(arg, 1);
struct timeval tv, *tvp;
if (timeout == OPTION_NONE)
tvp = NULL;
else {
timeout = OPTION_get(timeout);
tv.tv_sec = REC_SELINT32(timeout, 0);
tv.tv_usec = REC_SELINT(timeout, 1);
tvp = &tv;
}
return LIB7_Poll (lib7_state, poll_list, tvp);
} /* end of _lib7_OS_poll */
/* _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 */
/* _ml_Prof_setpref : word array option -> unit
*
* Set the profile array reference; NONE means that there is no array.
*/
ml_val_t _ml_Prof_setpref (ml_state_t *msp, ml_val_t arg)
{
#if defined(OPSYS_UNIX) || defined(OPSYS_WIN32)
bool_t enabled = (ProfCntArray != ML_unit);
int i;
if (arg != OPTION_NONE) {
ProfCntArray = OPTION_get(arg);
if (! enabled) {
/* add ProfCntArray to the C roots */
CRoots[NumCRoots++] = &ProfCntArray;
#ifdef OPSYS_UNIX
/* enable profiling signals */
EnableProfSignals ();
#endif
}
}
else if (enabled) {
/* remove ProfCntArray from the C roots */
for (i = 0; i < NumCRoots; i++) {
if (CRoots[i] == &ProfCntArray) {
CRoots[i] = CRoots[--NumCRoots];
break;
}
}
#ifdef OPSYS_UNIX
/* disable profiling signals */
DisableProfSignals ();
#endif
ProfCntArray = ML_unit;
}
return ML_unit;
#else
return RAISE_ERROR(msp, "time profiling not supported");
#endif
} /* end of _ml_Prof_setpref */
/* _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 */
/* getservbyport.c
*
* COPYRIGHT (c) 1995 AT&T Bell Laboratories.
*/
#include "sockets-osdep.h"
#include INCLUDE_SOCKET_H
#include "ml-base.h"
#include "ml-values.h"
#include "ml-objects.h"
#include "ml-c.h"
#include "cfun-proto-list.h"
#include "sock-util.h"
/* _ml_NetDB_getservbyport
* : (int * string option) -> (string * string list * int * string) option
*/
ml_val_t _ml_NetDB_getservbyport (ml_state_t *msp, ml_val_t arg)
{
ml_val_t mlProto = REC_SEL(arg, 1);
char *proto;
if (mlProto == OPTION_NONE)
proto = NIL(char *);
else
proto = STR_MLtoC(OPTION_get(mlProto));
return _util_NetDB_mkservent (msp, getservbyport (REC_SELINT(arg, 0), proto));
} /* end of _ml_NetDB_getservbyport */
