static Val set_time_profiling_rw_vector (Task* task, Val arg) {
// ============================
//
// Mythryl type: Null_Or(Rw_Vector(Unt)) -> Void
//
// This dis/ables handling of SIGVTALRM signals by the process,
// vs set__time_profiling_is_running__to() below which
// dis/ables sending of SIGVTALRM signals to the process,
//
// Set the profile array reference;
// NULL means that there is no array.
//
// This function is bound as set_time_profiling_rw_vector' in:
//
// src/lib/std/src/nj/runtime-profiling-control.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("set_time_profiling_rw_vector");
#ifdef OPSYS_UNIX
Bool enabled = (time_profiling_rw_vector__global != HEAP_VOID);
int i;
if (arg != OPTION_NULL) {
time_profiling_rw_vector__global = OPTION_GET( arg );
if (!enabled) {
//
c_roots__global[c_roots_count__global++] = &time_profiling_rw_vector__global; // Add time_profiling_rw_vector__global to the C roots.
//
start_incrementing__time_profiling_rw_vector__once_per_SIGVTALRM (); // Enable SIGVTALRM profiling signals via src/c/machine-dependent/posix-profiling-support.c
}
} else if (enabled) {
// Remove time_profiling_rw_vector__global from the C roots:
//
for (i = 0; i < c_roots_count__global; i++) {
//
if (c_roots__global[i] == &time_profiling_rw_vector__global) {
c_roots__global[i] = c_roots__global[ --c_roots_count__global ];
break;
}
}
// Disable profiling signals:
//
stop_incrementing__time_profiling_rw_vector__once_per_SIGVTALRM (); // Disable SIGVTALRM profiling signals via src/c/machine-dependent/posix-profiling-support.c
time_profiling_rw_vector__global = HEAP_VOID;
}
return HEAP_VOID;
#else
return RAISE_ERROR__MAY_HEAPCLEAN(task, "time profiling not supported", NULL);
#endif
}
Val _lib7_Date_strftime (Task* task, Val arg) {
//===================
//
// Mythryl type: (String, (Int, Int, Int, Int, Int, Int, Int, Int, Int)) -> String
//
// This takes a format field and nine integer fields (sec, min, hour, mday, mon,
// year, wday, yday, and isdst), and converts it into a string representation
// according to the format string.
//
// This fn gets bound to strf_time in:
//
// src/lib/std/src/date.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_Date_strftime");
Val fmt = GET_TUPLE_SLOT_AS_VAL(arg, 0);
Val date;
struct tm tm;
char buf[512];
size_t size;
date = GET_TUPLE_SLOT_AS_VAL(arg, 1);
tm.tm_sec = GET_TUPLE_SLOT_AS_INT(date, 0);
tm.tm_min = GET_TUPLE_SLOT_AS_INT(date, 1);
tm.tm_hour = GET_TUPLE_SLOT_AS_INT(date, 2);
tm.tm_mday = GET_TUPLE_SLOT_AS_INT(date, 3);
tm.tm_mon = GET_TUPLE_SLOT_AS_INT(date, 4);
tm.tm_year = GET_TUPLE_SLOT_AS_INT(date, 5);
tm.tm_wday = GET_TUPLE_SLOT_AS_INT(date, 6);
tm.tm_yday = GET_TUPLE_SLOT_AS_INT(date, 7);
tm.tm_isdst = GET_TUPLE_SLOT_AS_INT(date, 8);
Mythryl_Heap_Value_Buffer fmt_buf;
//
{ void* c_fmt
=
buffer_mythryl_heap_value(
//
&fmt_buf,
(void*) HEAP_STRING_AS_C_STRING(fmt),
strlen(HEAP_STRING_AS_C_STRING(fmt) ) +1 // '+1' for terminal NUL on string.
);
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_Date_strftime", NULL );
//
size = strftime (buf, sizeof(buf), c_fmt, &tm); // This call might not be slow enough to need CEASE/BEGIN guards. (Cannot return EINTR.)
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_Date_strftime" );
//
unbuffer_mythryl_heap_value( &fmt_buf );
}
if (size <= 0) return RAISE_ERROR__MAY_HEAPCLEAN(task, "strftime failed", NULL);
Val result = allocate_nonempty_ascii_string__may_heapclean(task, size, NULL); // Tried 'size+1' for terminal NUL byte here: It injected NULs into text logfiles. Ungood. -- 2011-11-19 CrT
strncpy (HEAP_STRING_AS_C_STRING( result ), buf, size);
return result;
}
Val _lib7_P_ProcEnv_ttyname (Task* task, Val arg) {
//=======================
//
// Mythryl type: Int -> String
//
// Return terminal name associated with file descriptor, if any.
//
// This fn gets bound as ttyname' in:
//
// src/lib/std/src/psx/posix-id.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
char* name = ttyname(TAGGED_INT_TO_C_INT(arg));
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
if (name == NULL) return RAISE_ERROR__MAY_HEAPCLEAN(task, "not a terminal device", NULL);
//
Val result = make_ascii_string_from_c_string__may_heapclean( task, name, NULL );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
// Get/set the rounding mode; the values are interpreted as follows:
//
// 0 To nearest
// 1 To zero
// 2 To +Inf
// 3 To -Inf
//
Val _lib7_Math_get_or_set_rounding_mode (Task* task, Val arg) {
//===================================
//
// Mythryl type: Null_Or(Int) -> Int
//
// This fn gets bound as get_or_set_rounding_mode in:
//
// src/lib/std/src/ieee-float.pkg
//
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
Val result;
#ifdef NO_ROUNDING_MODE_CTL
//
result = RAISE_ERROR__MAY_HEAPCLEAN(task, "Rounding mode control not supported", NULL);
//
#else
//
if (arg == OPTION_NULL) {
//
fe_rnd_mode_t resultt = fegetround();
result = RMODE_CtoLib7(resultt);
} else {
fe_rnd_mode_t mode = RMODE_LIB7toC( OPTION_GET( arg ));
fe_rnd_mode_t resultt = fesetround( mode ); // fesetround def in src/c/machine-dependent/prim.intel32.asm
result = RMODE_CtoLib7( resultt );
}
#endif
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_FileSys_readlink (Task* task, Val arg) {
//========================
//
// Mythryl type: String -> String
//
// Read the value of a symbolic link.
//
// The following implementation assumes that the system readlink
// fills the given buffer as much as possible, without nul-termination,
// and returns the number of bytes copied. If the buffer is not large
// enough, the return value will be at least the buffer size. In that
// case, we find out how big the link really is, allocate a buffer to
// hold it, and redo the readlink.
//
// Note that the above semantics are not those of POSIX, which requires
// null-termination on success, and only fills the buffer up to at most
// the penultimate byte even on failure.
//
// Should this be written to avoid the extra copy, using heap memory?
//
// This fn gets bound as readlink in:
//
// src/lib/std/src/posix-1003.1b/posix-file.pkg
// src/lib/std/src/posix-1003.1b/posix-file-system-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_FileSys_readlink");
struct stat sbuf;
int len;
int result;
char* heap_path = HEAP_STRING_AS_C_STRING( arg );
char buf[MAXPATHLEN];
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so copy heap_path into C storage:
//
Mythryl_Heap_Value_Buffer path_buf;
//
{ char* c_path
=
buffer_mythryl_heap_value( &path_buf, (void*) heap_path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink", NULL );
//
len = readlink(c_path, buf, MAXPATHLEN);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink" );
unbuffer_mythryl_heap_value( &path_buf );
}
if (len < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, len, NULL);
if (len < MAXPATHLEN) {
//
buf[len] = '\0';
return make_ascii_string_from_c_string__may_heapclean (task, buf, NULL);
}
// Buffer not big enough.
// Determine how big the link text is and allocate a buffer.
{ char* c_path
=
buffer_mythryl_heap_value( &path_buf, (void*) heap_path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink", NULL );
//
result = lstat (c_path, &sbuf);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink" );
unbuffer_mythryl_heap_value( &path_buf );
}
if (result < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, result, NULL);
int nlen = sbuf.st_size + 1;
char* nbuf = MALLOC(nlen);
if (nbuf == 0) return RAISE_ERROR__MAY_HEAPCLEAN(task, "out of malloc memory", NULL);
// Try the readlink again. Give up on error or if len is still bigger
// than the buffer size.
//
{ char* c_path
=
buffer_mythryl_heap_value( &path_buf, (void*) heap_path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink", NULL );
//
len = readlink(c_path, buf, len);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink" );
unbuffer_mythryl_heap_value( &path_buf );
}
if (len < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, len, NULL);
if (len >= nlen) return RAISE_ERROR__MAY_HEAPCLEAN(task, "readlink failure", NULL);
nbuf[len] = '\0';
Val chunk = make_ascii_string_from_c_string__may_heapclean (task, nbuf, NULL);
FREE (nbuf);
//
return chunk;
}
static Val set__time_profiling_is_running__to (Task* task, Val arg) {
// ==================================
//
// Mythryl type: Bool -> Void
//
// This dis/ables sending of SIGVTALRM signals to the process,
// vs set_time_profiling_rw_vector() above which
// dis/ables handling of SIGVTALRM signals by the process.
//
// This fn gets bound to set__time_profiling_is_running__to in:
//
// src/lib/std/src/nj/runtime-profiling-control.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("set__time_profiling_is_running__to");
#ifndef HAS_SETITIMER
//
return RAISE_ERROR__MAY_HEAPCLEAN(task, "time profiling not supported", NULL);
//
#else
// "The system provides each process with three interval timers,
// each decrementing in a distinct time domain. When any timer
// expires, a signal is sent to the process, and the timer
// (potentially) restarts.
//
// ITIMER_REAL Decrements in real time, and delivers SIGALRM upon expiration.
// ITIMER_VIRTUAL Decrements only when the process is executing, and delivers SIGVTALRM upon expiration.
// ITIMER_PROF Decrements both when the process executes and when the system is executing on behalf of the process.
// Coupled with ITIMER_VIRTUAL, this timer is usually used to profile the time spent by the application
// in user and kernel space. SIGPROF is delivered upon expiration.
//
// -- http://linux.about.com/library/cmd/blcmdl2_setitimer.htm
//
struct itimerval new_itv;
if (arg == HEAP_FALSE) {
//
new_itv.it_interval.tv_sec =
new_itv.it_value.tv_sec =
new_itv.it_interval.tv_usec =
new_itv.it_value.tv_usec = 0;
} else if (time_profiling_rw_vector__global == HEAP_VOID) {
//
return RAISE_ERROR__MAY_HEAPCLEAN(task, "no time_profiling_rw_vector set", NULL);
} else {
//
new_itv.it_interval.tv_sec =
new_itv.it_value.tv_sec = 0;
new_itv.it_interval.tv_usec =
new_itv.it_value.tv_usec = MICROSECONDS_PER_SIGVTALRM; // From src/c/h/profiler-call-counts.h
}
int status = setitimer (ITIMER_VIRTUAL, &new_itv, NULL);
RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
#endif
}
