/* Write the expression to the standard output. */
static exp_t *
prim_write(exp_t *args)
{
chkargs("write", args, 1);
printf("%s", tostr(car(args)));
return NULL;
}
/* Return the second element of a pair */
static exp_t *
prim_cdr(exp_t *args)
{
chkargs("cdr", args, 1);
if (!ispair(car(args)))
everr("cdr: the argument isn't a pair", car(args));
return cdar(args);
}
/* Evaluate the expressions inside the file pointed by ep */
static exp_t *
prim_load(exp_t *args)
{
chkargs("load", args, 1);
if (!isstr(car(args)))
everr("load: should be a string", car(args));
load(str(car(args)), NINTER);
return NULL;
}
/* Return the natural logarithm of the expression */
static exp_t *
prim_log(exp_t *args)
{
double v = 0.0;
chkargs("log", args, 1);
if (!isnum(car(args)) || (v = VALUE(car(args))) <= 0)
everr("log : not a positive number", car(args));
return nfloat(log(v));
}
/**
*
* @param secs
* @param nsecs
* @return
*/
int fcne(time_t secs, long nsecs)
{
/* print function name to stderr */
logerr(MLOGSTDERR, __FUNCTION__);
/* function input validation - validate arguments */
if(chkargs(secs, nsecs) < 0)
return (EXIT_FAILURE);
/* feature test macro for nanosleep */
#if _POSIX_C_SOURCE >= 199309L
#endif
return (EXIT_SUCCESS);
}
/**
*
* @param secs
* @param nsecs
* @return
*/
int fcnd(time_t secs, long nsecs)
{
struct timespec rqtp;
struct timespec rmtp;
int ret;
int idx;
rqtp.tv_sec = secs;
rqtp.tv_nsec = nsecs*1000000;
/* print function name to stderr */
logerr(MLOGSTDERR, __FUNCTION__);
/* function input validation - validate arguments */
if(chkargs(secs, nsecs) < 0)
return (EXIT_FAILURE);
/* feature test macro for nanosleep */
#if _POSIX_C_SOURCE >= 199309L
for(idx = 0; idx < 1000; idx++) {
ret = nanosleep(&rqtp, &rmtp);
/* nanosleep returned -1 and set errno to something
* other than interrupted */
if((ret == -1) && (errno != EINTR)) {
logerr(MLOGSTDERR | MLOGERRNO, "nanosleep");
return(EXIT_FAILURE);
}
}
#endif
return (EXIT_SUCCESS);
}
/* Return the value of the first argument to the exponent of the
second one */
static exp_t *
prim_pow(exp_t *args)
{
exp_t *res, *b;
long e;
unsigned long u;
chkargs("expt", args, 2);
CHKNUM(car(args), expt);
CHKNUM(cadr(args), expt);
res = cadr(args);
if (isint(res)) {
e = VALUE(res);
if (e == LONG_MIN)
u = LONG_MAX + 1UL;
else if (e < 0)
u = -e;
else
u = e;
res = nfixnum(1);
b = car(args);
while (u) {
if (u & 1) {
res = prod(res, b);
u--;
} else {
b = prod(b, b);
u /= 2;
}
}
if (e < 0)
res = divs(nfixnum(1), res);
} else
res = nfloat(pow(VALUE(car(args)),
VALUE(cadr(args))));
return res;
}
/* Return a pair of expression */
static exp_t *
prim_cons(exp_t *args)
{
chkargs("cons", args, 2);
return cons(car(args), cadr(args));
}
/* Test if the argument is a boolean. */
static exp_t *
prim_isbool(exp_t *args)
{
chkargs("boolean?", args, 1);
return isbool(car(args)) ? true: false;
}
/* Test if the argument is a character. */
static exp_t *
prim_ischar(exp_t *args)
{
chkargs("char?", args, 1);
return ischar(car(args)) ? true: false;
}
/* Test if the argument is a procedure. */
static exp_t *
prim_isproc(exp_t *args)
{
chkargs("procedure?", args, 1);
return isproc(car(args)) ? true: false;
}
/* Test if the argument is a number */
static exp_t *
prim_isnum(exp_t *args)
{
chkargs("number?", args, 1);
return isnum(car(args)) ? true: false;
}
/* Test if the expression is a pair */
static exp_t *
prim_pair(exp_t *args)
{
chkargs("pair?", args, 1);
return ispair(car(args)) ? true : false;
}
/* Test if the expression is a symbol */
static exp_t *
prim_sym(exp_t *args)
{
chkargs("symbol?", args, 1);
return issym(car(args)) ? true : false;
}
/* Test if two expressions occupy the same physical memory */
static exp_t *
prim_eq(exp_t *args)
{
chkargs("eq?", args, 2);
return iseq(car(args), cadr(args)) ? true : false;
}
