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 }