ssize_t
floorFloat(ssize_t f)
{
double r;
ssize_t i;
r = get_d(f);
if( r >= 0.0 )
{
if ( r >= (Max_Int_d + 1.0) )
{
raise_exn((uintptr_t)&exn_OVERFLOW);
}
return (convertIntToML((ssize_t) r));
}
if( r < Min_Int_d )
{
raise_exn((uintptr_t)&exn_OVERFLOW);
}
i = (ssize_t) r;
if( r < ((double) i) )
{
i -= 1;
}
return convertIntToML(i);
}
static cache *
cacheCreate (int maxsize, int timeout, unsigned long hash, request_data *rd) /*{{{ */
{
// create pool for cache to live in
apr_status_t s;
apr_pool_t *p;
s = apr_pool_create (&p, (apr_pool_t *) NULL);
if (s != APR_SUCCESS)
{
ap_log_error(APLOG_MARK,LOG_WARNING,0,rd->server,"cacheCreate: could not create memory pool");
raise_exn ((int) &exn_OVERFLOW);
}
cache *c = (cache *) apr_palloc (p, sizeof (cache));
if (c == NULL)
{
ap_log_error(APLOG_MARK,LOG_WARNING,0,rd->server,"cacheCreate: could not allocate memory from pool");
raise_exn ((int) &exn_OVERFLOW);
}
ap_log_error(APLOG_MARK,LOG_DEBUG,0,rd->server,"cacheCreate: 0x%x", (unsigned int) c);
c->pool = p;
c->hashofname = hash;
apr_proc_mutex_lock(rd->ctx->cachelock.plock);
unsigned long cachehash = hash % rd->ctx->cachelock.shmsize;
c->version = rd->ctx->cachelock.version[cachehash];
apr_proc_mutex_unlock(rd->ctx->cachelock.plock);
// setup locks
apr_thread_rwlock_create (&(c->rwlock), c->pool);
apr_thread_mutex_create (&(c->mutex), APR_THREAD_MUTEX_DEFAULT, c->pool);
// setup linked list
c->sentinel = (entry *) apr_palloc (c->pool, sizeof (entry));
c->sentinel->up = c->sentinel;
c->sentinel->down = c->sentinel;
c->sentinel->key = NULL;
// c->sentinel->key.hash = 0;
c->sentinel->data = NULL;
c->sentinel->size = 0;
// setup hashtable & binary heap
c->htable = (entrytable_hashtable_t *) apr_palloc (c->pool, sizeof (entrytable_hashtable_t) + sizeof(cacheheap_binaryheap_t));
c->heap = (cacheheap_binaryheap_t *) (c->htable + 1);
entrytable_init (c->htable);
cacheheap_heapinit(c->heap);
// calculate size
c->size = c->htable->hashTableSize * sizeof (entrytable_hashelement_t);
c->maxsize = maxsize;
// set timeout scheme
c->timeout = timeout;
return c;
} /*}}} */
long
REG_POLY_FUN_HDR(sml_getpwnam, long tuple, Region homeR, Region shellR, String nameML, long s, long exn)
{
long res;
char *b;
struct passwd pbuf, *pbuf2;
char *name = &(nameML->data);
mkTagRecordML(tuple,5);
s = convertIntToC(s) + 1;
b = (char *) malloc(s);
if (!b)
{
res = errno;
elemRecordML(tuple,4) = res;
return tuple;
}
res = getpwnam_r(name, &pbuf, b, s-1, &pbuf2);
elemRecordML(tuple,4) = res;
if (res)
{
free(b);
return tuple;
}
if (!pbuf2)
{
free(b);
raise_exn(exn);
}
elemRecordML(tuple,0) = (long) pbuf2->pw_uid;
elemRecordML(tuple,1) = (long) pbuf2->pw_gid;
elemRecordML(tuple,2) = (long) REG_POLY_CALL(convertStringToML, homeR, pbuf2->pw_dir);
elemRecordML(tuple,3) = (long) REG_POLY_CALL(convertStringToML, shellR, pbuf2->pw_shell);
free(b);
return tuple;
}
ssize_t
ceilFloat(ssize_t f)
{
double arg;
ssize_t i;
arg = get_d(f);
if( arg >= 0.0 )
{
if( arg > Max_Int_d ) goto raise_ceil;
i = (ssize_t) arg;
if( arg > ((double) i) ) i += 1;
}
else
{
if( arg <= (Min_Int_d - 1.0) ) goto raise_ceil;
i = (ssize_t) arg;
}
return convertIntToML(i);
raise_ceil:
raise_exn((uintptr_t)&exn_OVERFLOW);
return 0; // never reached
}
ssize_t
__div_int32ub(ssize_t x, ssize_t y, uintptr_t exn) /* ML */
{
if (y == 0)
{
raise_exn(exn);
return 0; // never reached
}
if ( y == -1 && x == (-2147483647 - 1) )
{
raise_exn((uintptr_t)&exn_OVERFLOW);
return 0; // never reached
}
if (x < 0 && y > 0)
return ((x + 1) / y) - 1;
else if (x > 0 && y < 0)
return ((x - 1) / y) - 1;
else return x / y;
}
size_t
__div_word32ub(size_t x, size_t y, uintptr_t exn) /* ML */
{
if ( y == 0 )
{
raise_exn(exn);
return 0; // never reached
}
return (x / y);
}
size_t
__mod_word32ub(size_t x, size_t y, uintptr_t exn)
{
if ( y == 0 )
{
raise_exn(exn);
return 0; // never reached
}
return (x % y);
}
size_t
chrCharML(size_t charNrML, uintptr_t exn)
{
size_t charNrC = convertIntToC(charNrML);
if ( charNrC >= 0 && charNrC <= 255 )
{
return convertIntToML (charNrC);
}
raise_exn(exn);
return 0; // never reached
}
ssize_t
__div_int31(ssize_t x, ssize_t y, uintptr_t exn) /* ML */
{
if (y == 1)
{
raise_exn(exn);
return 0; // never reached
}
if ( y == -1 && x == -2147483647 ) // -2147483647 = 2 * Int31.minInt + 1
{
raise_exn((uintptr_t)&exn_OVERFLOW);
return 0; // never reached
}
if (x == 1) return 1;
if (x < 1 && y > 1)
return (2*((x+1)/(y-1))-1);
else if (x > 1 && y < 1)
return (2*((x-3)/(y-1))-1);
else return (2*((x-1)/(y-1))+1);
}
ssize_t
truncFloat(ssize_t f)
{
double r;
r = get_d(f);
if ((r >= (Max_Int_d + 1.0)) || (r <= (Min_Int_d - 1.0)))
{
raise_exn((uintptr_t)&exn_OVERFLOW);
}
return convertIntToML((ssize_t)r);
}
size_t
__div_word31(size_t x, size_t y, uintptr_t exn) /* ML */
{
size_t xC = i31_to_i32ub(x);
size_t yC = i31_to_i32ub(y);
if ( yC == 0 )
{
raise_exn(exn);
return 0; // never reached
}
return i32ub_to_i31(xC / yC);
}
ssize_t
__mod_int31(ssize_t xML, ssize_t yML, uintptr_t exn)
{
if ( yML == 1 )
{
raise_exn(exn);
return 0; // never reached
}
if ((xML-1)%(yML-1) == 0 || (xML>1 && yML>1) || (xML<1 && yML<1))
return ((xML-1)%(yML-1))+1;
else
return ((xML-1)%(yML-1))+yML;
}
ssize_t
__mod_int32ub(ssize_t x, ssize_t y, uintptr_t exn)
{
if ( y == 0 )
{
raise_exn(exn);
return 0; // never reached
}
if ( (x > 0 && y > 0) || (x < 0 && y < 0) || (x % y == 0) )
{
return x % y;
}
return (x % y) + y;
}
ssize_t
sml_sysconf(ssize_t t)
{
long res;
switch (convertIntToC(t))
{
case 1:
res = sysconf(_SC_ARG_MAX);
break;
case 2:
res = sysconf(_SC_CHILD_MAX);
break;
case 3:
res = sysconf(_SC_CLK_TCK);
break;
case 4:
res = sysconf(_SC_NGROUPS_MAX);
break;
case 5:
res = sysconf(_SC_OPEN_MAX);
break;
case 6:
res = sysconf(_SC_STREAM_MAX);
break;
case 7:
res = sysconf(_SC_TZNAME_MAX);
break;
case 8:
res = sysconf(_SC_JOB_CONTROL);
break;
case 9:
res = sysconf(_SC_SAVED_IDS);
break;
case 10:
res = sysconf(_SC_VERSION);
break;
case 11:
res = sysconf(_SC_GETGR_R_SIZE_MAX);
break;
case 12:
res = sysconf(_SC_GETPW_R_SIZE_MAX);
break;
default:
raise_exn((uintptr_t)&exn_OVERFLOW);
res = 0;
break;
}
return convertIntToML((ssize_t) res);
}
uintptr_t
sml_times(uintptr_t tuple)
{
struct tms buf;
clock_t r;
mkTagRecordML(tuple, 5);
r = times(&buf);
if (r == (clock_t) -1) raise_exn((uintptr_t)&exn_OVERFLOW);
elemRecordML(tuple,0) = convertIntToML(r & (SIZE_MAX / 4));
elemRecordML(tuple,1) = convertIntToML(buf.tms_utime & (SIZE_MAX / 4));
elemRecordML(tuple,2) = convertIntToML(buf.tms_stime & (SIZE_MAX / 4));
elemRecordML(tuple,3) = convertIntToML(buf.tms_cutime & (SIZE_MAX / 4));
elemRecordML(tuple,4) = convertIntToML(buf.tms_cstime & (SIZE_MAX / 4));
return tuple;
}
uintptr_t
REG_POLY_FUN_HDR(sml_getgrnam, uintptr_t triple, Region memberListR, Region memberR, String nameML, size_t s, uintptr_t exn)
{
uintptr_t res;
uintptr_t *list, *pair;
char *b;
struct group gbuf, *gbuf2;
char **members;
char *name = &(nameML->data);
mkTagTripleML(triple);
s = convertIntToC(s) + 1;
b = (char *) malloc(s);
if (!b)
{
res = errno;
third(triple) = res;
return triple;
}
res = getgrnam_r(name, &gbuf, b, s-1, &gbuf2);
third(triple) = res;
if (res)
{
free(b);
return triple;
}
if (!gbuf2)
{
free(b);
raise_exn(exn);
}
first(triple) = convertIntToML(gbuf2->gr_gid);
members = gbuf2->gr_mem;
makeNIL(list);
while (*members)
{
allocPairML(memberListR, pair);
first(pair) = (uintptr_t) REG_POLY_CALL(convertStringToML, memberR, *members);
second(pair) = (uintptr_t) list;
makeCONS(pair, list);
members++;
}
free(b);
second(triple) = (uintptr_t) list;
return triple;
}
// convertStringToC: Copy ML string to 'buf' of size 'buflen'
void
convertStringToC(String mlStr, char *buf, size_t buflen, uintptr_t exn)
{
size_t sz;
char *p;
sz = sizeStringDefine(mlStr);
if ( sz > buflen-1)
{
raise_exn(exn);
}
for ( p = &(mlStr->data); *p != '\0'; )
{
*buf++ = *p++;
}
*buf = '\0';
return;
}
uintptr_t
REG_POLY_FUN_HDR(sml_getgroups, uintptr_t rp, Region rs, uintptr_t exn)
{
uintptr_t *pair, *list;
gid_t *tmp;
size_t r, i;
makeNIL(list);
mkTagPairML(rp);
r = getgroups(0, NULL);
if (r == -1)
{
first (rp) = r;
second(rp) = (uintptr_t) list;
return rp;
}
tmp = (gid_t *) malloc(sizeof(gid_t) * r);
if (!tmp)
{
first (rp) = convertIntToML(-1);
second(rp) = (uintptr_t) list;
return rp;
}
r = getgroups(r, tmp);
if (r == -1)
{
free(tmp);
raise_exn(exn);
}
for(i=0; i<r; i++)
{
REG_POLY_CALL(allocPairML, rs, pair);
first(pair) = (uintptr_t) convertIntToML(tmp[i]);
second(pair) = (uintptr_t) list;
makeCONS(pair, list)
}
free(tmp);
first(rp) = convertIntToML(0);
second(rp) = (uintptr_t) list;
return rp;
}
String
REG_POLY_FUN_HDR(sml_asctime, Region rAddr, uintptr_t v, int exn)
{
struct tm tmr;
char *r;
char res[30]; /* Should at least be 26 + 0 termination according to man asctime */
tmr.tm_hour = convertIntToC(elemRecordML(v,0));
tmr.tm_isdst = convertIntToC(elemRecordML(v,1));
tmr.tm_mday = convertIntToC(elemRecordML(v,2));
tmr.tm_min = convertIntToC(elemRecordML(v,3));
tmr.tm_mon = convertIntToC(elemRecordML(v,4));
tmr.tm_sec = convertIntToC(elemRecordML(v,5));
tmr.tm_wday = convertIntToC(elemRecordML(v,6));
tmr.tm_yday = convertIntToC(elemRecordML(v,7));
tmr.tm_year = convertIntToC(elemRecordML(v,8));
r = asctime_r(&tmr, res);
if ( r == NULL )
{
raise_exn(exn);
}
return REG_POLY_CALL(convertStringToML, rAddr, res);
}
String
REG_POLY_FUN_HDR(sml_strftime, Region rAddr, String fmt, uintptr_t v, int exn)
{
struct tm tmr;
int ressize;
#define BUFSIZE 256
char buf[BUFSIZE];
tmr.tm_hour = convertIntToC(elemRecordML(v,0));
tmr.tm_isdst = convertIntToC(elemRecordML(v,1));
tmr.tm_mday = convertIntToC(elemRecordML(v,2));
tmr.tm_min = convertIntToC(elemRecordML(v,3));
tmr.tm_mon = convertIntToC(elemRecordML(v,4));
tmr.tm_sec = convertIntToC(elemRecordML(v,5));
tmr.tm_wday = convertIntToC(elemRecordML(v,6));
tmr.tm_yday = convertIntToC(elemRecordML(v,7));
tmr.tm_year = convertIntToC(elemRecordML(v,8));
ressize = strftime(buf, BUFSIZE, &(fmt->data), &tmr);
if ( ressize == 0 || ressize == BUFSIZE )
{
raise_exn(exn);
}
return REG_POLY_CALL(convertStringToML, rAddr, buf);
#undef BUFSIZE
}