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_FileSys_symlink (Task* task, Val arg) {
//=======================
//
// Mythryl type: (String, String) -> Void
// existing newname
//
// Creates a symbolic link from newname to existing file.
//
// This fn gets bound as symlink' in:
//
// src/lib/std/src/psx/posix-file.pkg
// src/lib/std/src/psx/posix-file-system-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int status;
Val existing = GET_TUPLE_SLOT_AS_VAL( arg, 0 );
Val new_name = GET_TUPLE_SLOT_AS_VAL( arg, 1 );
char* heap_existing = HEAP_STRING_AS_C_STRING( existing );
char* heap_new_name = HEAP_STRING_AS_C_STRING( new_name );
// 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_existing and
// heap_new_name into C storage:
//
Mythryl_Heap_Value_Buffer existing_buf;
Mythryl_Heap_Value_Buffer new_name_buf;
//
{ char* c_existing = buffer_mythryl_heap_value( &existing_buf, (void*) heap_existing, strlen( heap_existing ) +1 ); // '+1' for terminal NUL on string.
char* c_new_name = buffer_mythryl_heap_value( &new_name_buf, (void*) heap_new_name, strlen( heap_new_name ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = symlink( c_existing, c_new_name );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
unbuffer_mythryl_heap_value( &existing_buf );
unbuffer_mythryl_heap_value( &new_name_buf );
}
Val result = RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
static void register_compiled_file_exports__may_heapclean (
// =============================================
//
Task* task,
Picklehash* c_picklehash, // Picklehash key as a C string.
Val exports_tree,
Roots* extra_roots
){
Roots roots1 = { &exports_tree, extra_roots };
///////////////////////////////////////////////////////////
// Add a picklehash/exports_tree key/val naming pair
// to our heap-allocated list of loaded compiled_files.
///////////////////////////////////////////////////////////
// Copy the picklehash naming this compiledfile
// into the Mythryl heap, so that we can use
// it in a Mythryl-heap record:
//
Val heap_picklehash = allocate_nonempty_ascii_string__may_heapclean( task, PICKLEHASH_BYTES, &roots1 ); // allocate_nonempty_ascii_string__may_heapclean def in src/c/heapcleaner/make-strings-and-vectors-etc.c
memcpy( HEAP_STRING_AS_C_STRING(heap_picklehash), (char*)c_picklehash, PICKLEHASH_BYTES );
// Allocate the list record and thread it onto the exports list:
//
PERVASIVE_PACKAGE_PICKLE_LIST__GLOBAL
=
make_three_slot_record( task,
//
heap_picklehash, // Key naming compiledfile -- first slot in new record.
exports_tree, // Tree of values exported from compiledfile -- second slot in new record.
PERVASIVE_PACKAGE_PICKLE_LIST__GLOBAL // Pointer to next record in list -- third slot in new record.
);
}
Val _lib7_Date_ascii_time (Task* task, Val arg) {
//==================
//
// Mythryl type: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> String
//
// This takes a nine-tuple date (fields sec, min, hour, mday, mon, year, wday,
// yday, and isdst), and converts it into a string representation.
//
// This fn gets bound to 'ascii_time' in:
//
// src/lib/std/src/date.pkg
struct tm tm;
//
tm.tm_sec = GET_TUPLE_SLOT_AS_INT(arg, 0);
tm.tm_min = GET_TUPLE_SLOT_AS_INT(arg, 1);
tm.tm_hour = GET_TUPLE_SLOT_AS_INT(arg, 2);
tm.tm_mday = GET_TUPLE_SLOT_AS_INT(arg, 3);
tm.tm_mon = GET_TUPLE_SLOT_AS_INT(arg, 4);
tm.tm_year = GET_TUPLE_SLOT_AS_INT(arg, 5);
tm.tm_wday = GET_TUPLE_SLOT_AS_INT(arg, 6);
tm.tm_yday = GET_TUPLE_SLOT_AS_INT(arg, 7);
tm.tm_isdst = GET_TUPLE_SLOT_AS_INT(arg, 8);
Val result = allocate_nonempty_ascii_string(task, DATE_LEN);
strncpy (HEAP_STRING_AS_C_STRING(result), asctime(&tm), DATE_LEN);
return result;
}
Val _lib7_P_SysDB_getgrnam (Task* task, Val arg) {
//======================
//
// Mythryl type: String -> (String, Unt, List(String))
//
// Get group file entry by name.
//
// This fn gets bound as getgrname' in:
//
// src/lib/std/src/posix-1003.1b/posix-etc.pkg
struct group* info = getgrnam( HEAP_STRING_AS_C_STRING( arg ));
if (info == NULL) return RAISE_SYSERR(task, -1);
Val gr_name = make_ascii_string_from_c_string( task, info->gr_name );
Val gr_gid;
WORD_ALLOC (task, gr_gid, (Val_Sized_Unt)(info->gr_gid));
Val gr_mem = make_ascii_strings_from_vector_of_c_strings( task, info->gr_mem );
Val result;
REC_ALLOC3(task, result, gr_name, gr_gid, gr_mem);
return result;
}
/* _lib7_win32_PS_system : String -> one_word_unt
* command
*
*/
Val _lib7_win32_PS_system(Task *task, Val arg)
{
int ret = system(HEAP_STRING_AS_C_STRING(arg));
Val res;
WORD_ALLOC(task, res, (Val_Sized_Unt)ret);
return res;
}
Val _lib7_P_IO_readbuf (Task* task, Val arg) {
//==================
//
// Mythryl type: (Int, rw_vector_of_one_byte_unts::Rw_Vector, Int, Int) -> Int
// fd data nbytes start
//
// Read nbytes of data from the specified file
// into the given array starting at start.
// Return the number of bytes read.
// Assume bounds have been checked.
//
// This fn gets bound as readbuf' in:
//
// src/lib/std/src/posix-1003.1b/posix-io.pkg
// src/lib/std/src/posix-1003.1b/posix-io-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_IO_readbuf");
int fd = GET_TUPLE_SLOT_AS_INT( arg, 0 );
// Val buf = GET_TUPLE_SLOT_AS_VAL( arg, 1 ); // We'll do this after the read().
int nbytes = GET_TUPLE_SLOT_AS_INT( arg, 2 );
// int offset = GET_TUPLE_SLOT_AS_INT( arg, 3 ); // We'll do this after the read().
int n;
Mythryl_Heap_Value_Buffer vec_buf;
{ char* c_vec // Get a pointer to 'nbytes' of free ram outside the Mythryl heap
= // (i.e., ram guaranteed not to move around during a heapcleaning).
buffer_mythryl_heap_nonvalue( &vec_buf, nbytes );
/* do { */ // Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_IO_readbuf", &arg ); // 'arg' is still live here!
//
n = read( fd, c_vec, nbytes );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_IO_readbuf" );
/* } while (n < 0 && errno == EINTR); */ // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
// The heapcleaner may have moved everything around
// during our read() call, so we wait until now to
// track down the location of our buf vector:
//
Val buf = GET_TUPLE_SLOT_AS_VAL( arg, 1 );
char* start = HEAP_STRING_AS_C_STRING(buf) + GET_TUPLE_SLOT_AS_INT( arg, 3 );
// Copy the bytes read into given
// string 'buf' on Mythryl heap:
//
memcpy( start, c_vec, n ); // Caller is responsible for guaranteeing that this will not overrun the vector and clobber the Mythryl heap.
unbuffer_mythryl_heap_value( &vec_buf );
}
RETURN_STATUS_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, n, NULL);
}
Val _lib7_P_Process_exece (Task* task, Val arg) {
//=====================
//
// _lib7_P_Process_exece : String * String list * String list -> 'a
//
// Overlay a new process image, using specified environment.
//
// This fn gets bound as exece in:
//
// src/lib/std/src/posix-1003.1b/posix-process.pkg
Val path = GET_TUPLE_SLOT_AS_VAL( arg, 0 );
Val arglst = GET_TUPLE_SLOT_AS_VAL( arg, 1 );
Val envlst = GET_TUPLE_SLOT_AS_VAL( arg, 2 );
// Use the heap for temp space for
// the argv[] and envp[] vectors:
//
char** cp = (char**)(task->heap_allocation_pointer);
#ifdef SIZES_C_64_MYTHRYL_32
//
// 8-byte align it:
//
cp = (char**) ROUND_UP_TO_POWER_OF_TWO((Unt2)cp, POINTER_BYTESIZE);
#endif
char** argv = cp;
//
for (Val p = arglst; p != LIST_NIL; p = LIST_TAIL(p)) {
*cp++ = HEAP_STRING_AS_C_STRING(LIST_HEAD(p));
}
*cp++ = 0; // Terminate the argv[].
char** envp = cp;
//
for (Val p = envlst; p != LIST_NIL; p = LIST_TAIL(p)) {
*cp++ = HEAP_STRING_AS_C_STRING(LIST_HEAD(p));
}
*cp++ = 0; // Terminate the envp[].
int status = execve( HEAP_STRING_AS_C_STRING(path), argv, envp );
CHECK_RETURN (task, status)
}
/* do__set_window_title
*
* opengl-client.api type: (Session, String) -> Void
* opengl-client-driver.api type: (Session, String) -> Void
*/
static Val do__set_window_title (Task* task, Val arg)
{
char* s0 = HEAP_STRING_AS_C_STRING (GET_TUPLE_SLOT_AS_VAL( arg, 1));
glfwSetWindowTitle( s0 );
return HEAP_VOID;
}
Val _lib7_P_FileSys_link (Task* task, Val arg) {
//====================
//
// Mythryl type: (String, String) -> Void
// existing newname
//
// Creates a hard link from newname to existing file.
//
// This fn gets bound as link' in:
//
// src/lib/std/src/posix-1003.1b/posix-file.pkg
// src/lib/std/src/posix-1003.1b/posix-file-system-64.pkg
Val existing = GET_TUPLE_SLOT_AS_VAL(arg, 0);
Val newname = GET_TUPLE_SLOT_AS_VAL(arg, 1);
int status = link(HEAP_STRING_AS_C_STRING(existing), HEAP_STRING_AS_C_STRING(newname));
CHECK_RETURN_UNIT (task, status)
}
Val _lib7_U_Dynload_dlopen (Task* task, Val arg) { // (String, Bool, Bool) -> one_word_unt::Unt
//======================
//
// Open a dynamically loaded library.
//
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_U_Dynload_dlopen");
Val ml_libname = GET_TUPLE_SLOT_AS_VAL (arg, 0);
int lazy = GET_TUPLE_SLOT_AS_VAL (arg, 1) == HEAP_TRUE;
int global = GET_TUPLE_SLOT_AS_VAL (arg, 2) == HEAP_TRUE;
char *libname = NULL;
void *handle;
Mythryl_Heap_Value_Buffer libname_buf;
if (ml_libname != OPTION_NULL) {
//
libname = HEAP_STRING_AS_C_STRING (OPTION_GET (ml_libname));
//
// Copy libname out of Mythryl heap to
// make it safe to reference between
// RELEASE_MYTHRYL_HEAP and
// RECOVER_MYTHRYL_HEAP:
//
libname = (char*) buffer_mythryl_heap_value( &libname_buf, (void*)libname, strlen(libname)+1 ); // '+1' for terminal NUL on string.
}
#ifdef OPSYS_WIN32
handle = (void *) LoadLibrary (libname);
if (handle == NULL && libname != NULL) dlerror_set ("Library `%s' not found", libname);
#else
int flag = (lazy ? RTLD_LAZY : RTLD_NOW);
if (global) flag |= RTLD_GLOBAL;
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_U_Dynload_dlopen", NULL );
//
handle = dlopen (libname, flag);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_U_Dynload_dlopen" );
#endif
if (libname) unbuffer_mythryl_heap_value( &libname_buf );
return make_one_word_unt(task, (Vunt) handle );
}
Val _lib7_P_IO_writebuf (Task* task, Val arg) {
//===================
//
// Mythryl type: (Int, rw_vector_of_one_byte_unts::Rw_Vector, Int, Int) -> Int
// fd data nbytes start
//
// Write nbytes of data from the given rw_vector to the specified file,
// starting at the given offset. Assume bounds have been checked.
//
// This fn gets bound as writevec', writearr' in:
//
// src/lib/std/src/psx/posix-io.pkg
// src/lib/std/src/psx/posix-io-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int fd = GET_TUPLE_SLOT_AS_INT( arg, 0);
Val buf = GET_TUPLE_SLOT_AS_VAL( arg, 1);
size_t nbytes = GET_TUPLE_SLOT_AS_INT( arg, 2);
char* heap_data = HEAP_STRING_AS_C_STRING(buf) + GET_TUPLE_SLOT_AS_INT(arg, 3);
ssize_t n;
// 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_data into C storage:
//
Mythryl_Heap_Value_Buffer data_buf;
//
{ char* c_data
=
buffer_mythryl_heap_value( &data_buf, (void*) heap_data, nbytes );
do {
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
n = write (fd, c_data, nbytes);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
//
} while (n < 0 && errno == EINTR); // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
unbuffer_mythryl_heap_value( &data_buf );
}
Val result = RETURN_STATUS_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, n, NULL); // from src/c/lib/raise-error.h
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_Process_exec (Task* task, Val arg) {
//=====================
//
// Mythryl type: (String, List(String) -> X
//
// Overlay a new process image
//
// This fn gets bound as exec in:
//
// src/lib/std/src/posix-1003.1b/posix-process.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_Process_exec");
Val path = GET_TUPLE_SLOT_AS_VAL(arg, 0);
Val arglst = GET_TUPLE_SLOT_AS_VAL(arg, 1);
// Use the heap for temp space for the argv[] vector
//
char** cp = (char**) (task->heap_allocation_pointer);
#ifdef SIZES_C_64_MYTHRYL_32
//
// 8-byte align it:
//
cp = (char **)ROUNDUP((Unt2)cp, POINTER_BYTESIZE);
#endif
char** argv = cp;
//
for (Val p = arglst; p != LIST_NIL; p = LIST_TAIL(p)) {
//
*cp++ = HEAP_STRING_AS_C_STRING(LIST_HEAD(p));
}
*cp++ = 0; // Terminate the argv[].
int status = execv(HEAP_STRING_AS_C_STRING(path), argv);
RETURN_STATUS_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
}
Val _lib7_netdb_get_service_by_name (Task* task, Val arg) {
//===============================
//
// Mythryl type: (String, Null_Or(String)) -> Null_Or( (String, List(String), Int, String) )
//
// This fn gets bound as get_service_by_name' in:
//
// src/lib/std/src/socket/net-service-db.pkg
Val mlServ = GET_TUPLE_SLOT_AS_VAL( arg, 0 );
Val mlProto = GET_TUPLE_SLOT_AS_VAL( arg, 1 );
char* proto;
if (mlProto == OPTION_NULL) proto = NULL;
else proto = HEAP_STRING_AS_C_STRING(OPTION_GET(mlProto));
return _util_NetDB_mkservent ( // _util_NetDB_mkservent def in src/c/lib/socket/util-mkservent.c
task,
getservbyname( HEAP_STRING_AS_C_STRING( mlServ ), proto)
);
}
Val _lib7_P_FileSys_chown (Task* task, Val arg) {
//=====================
//
// Mythryl type: (String, Unt, Unt) -> Void
// name uid gid
//
// Change owner and group of file given its name.
//
// This fn gets bound as chown' in:
//
// src/lib/std/src/psx/posix-file.pkg
// src/lib/std/src/psx/posix-file-system-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int status;
Val path = GET_TUPLE_SLOT_AS_VAL( arg, 0);
uid_t uid = TUPLE_GETWORD( arg, 1);
gid_t gid = TUPLE_GETWORD( arg, 2);
char* heap_path= HEAP_STRING_AS_C_STRING(path);
// 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*) path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = chown (c_path, uid, gid);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
//
unbuffer_mythryl_heap_value( &path_buf );
}
Val result = RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_FileSys_openf (Task* task, Val arg) {
//=====================
//
// Mythryl type: (String, Unt, Unt) -> int
// name flags mode
//
// Open a file and return the file descriptor.
//
// This fn gets bound as openf' 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_openf");
Val path = GET_TUPLE_SLOT_AS_VAL( arg, 0);
int flags = TUPLE_GETWORD( arg, 1);
int mode = TUPLE_GETWORD( arg, 2);
int fd;
char* heap_path = HEAP_STRING_AS_C_STRING( path );
// 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.
/* do { */ // Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_openf", NULL );
//
fd = open( c_path, flags, mode );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_openf" );
/* } while (fd < 0 && errno == EINTR); */ // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
unbuffer_mythryl_heap_value( &path_buf );
}
RETURN_STATUS_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN( task, fd, NULL );
}
Val _lib7_netdb_get_protocol_by_name (Task* task, Val arg) {
//================================
//
// Mythryl type: String -> Null_Or( (String, List(String), Int) )
//
// This fn gets bound as get_prot_by_name' in:
//
// src/lib/std/src/socket/net-protocol-db.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
struct protoent* pentry;
char* heap_name = HEAP_STRING_AS_C_STRING( arg ); // Last use of 'arg'.
// 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_name into C storage:
//
Mythryl_Heap_Value_Buffer name_buf;
//
{ char* c_name = buffer_mythryl_heap_value( &name_buf, (void*) heap_name, strlen( heap_name ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
pentry = getprotobyname( c_name );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
unbuffer_mythryl_heap_value( &name_buf );
}
if (pentry == NULL) return OPTION_NULL;
Val name = make_ascii_string_from_c_string__may_heapclean (task, pentry->p_name, NULL ); Roots roots1 = { &name, NULL };
Val aliases = make_ascii_strings_from_vector_of_c_strings__may_heapclean (task, pentry->p_aliases, &roots1 );
Val result
=
make_three_slot_record( task, name, aliases, TAGGED_INT_FROM_C_INT(pentry->p_proto) );
result = OPTION_THE( task, result );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_SysDB_getpwnam (Task* task, Val arg) {
//======================
//
// _lib7_P_SysDB_getpwnam : String -> (String, word, word, String, String)
//
// Get password file entry by name.
//
// This fn gets bound as getpwnam' in:
//
// src/lib/std/src/posix-1003.1b/posix-etc.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_SysDB_getpwnam");
struct passwd* info;
// 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 name_buf;
//
{ char* heap_name = HEAP_STRING_AS_C_STRING( arg );
char* c_name
=
buffer_mythryl_heap_value( &name_buf, (void*) heap_name, strlen( heap_name ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_SysDB_getpwnam", NULL );
//
info = getpwnam( c_name );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_SysDB_getpwnam" );
unbuffer_mythryl_heap_value( &name_buf );
}
if (info == NULL) return RAISE_SYSERR__MAY_HEAPCLEAN(task, -1, NULL);
Val pw_name = make_ascii_string_from_c_string__may_heapclean( task, info->pw_name, NULL ); Roots roots1 = { &pw_name, NULL };
Val pw_uid = make_one_word_unt( task, (Vunt) (info->pw_uid) ); Roots roots2 = { &pw_uid, &roots1 };
Val pw_gid = make_one_word_unt( task, (Vunt) (info->pw_gid) ); Roots roots3 = { &pw_gid, &roots2 };
Val pw_dir = make_ascii_string_from_c_string__may_heapclean( task, info->pw_dir, &roots3 ); Roots roots4 = { &pw_dir, &roots3 };
Val pw_shell = make_ascii_string_from_c_string__may_heapclean( task, info->pw_shell, &roots4 );
return make_five_slot_record(task, pw_name, pw_uid, pw_gid, pw_dir, pw_shell );
}
Val _lib7_P_Process_osval (Task* task, Val arg) {
//=====================
//
// Mythryl type: String -> Int
//
// Return the OS-dependent, compile-time constant specified by the string.
//
// This fn gets bound as osval in:
//
// src/lib/std/src/posix-1003.1b/posix-process.pkg
name_val_t* result = _lib7_posix_nv_lookup (HEAP_STRING_AS_C_STRING(arg), values, NUMELMS);
//
if (result) return TAGGED_INT_FROM_C_INT(result->val);
else return RAISE_ERROR(task, "system constant not defined");
}
/* _lib7_win32_PS_create_process : String -> one_word_unt
*
* Note: This function returns the handle to the created process
* This handle will need to be freed before the system releases
* the memory associated to the process.
* We will take care of this in the wait_for_single_chunk
* call. This is for the time being only used by threadkit.
* It could also cause problems later on.
*/
Val _lib7_win32_PS_create_process(Task *task, Val arg)
{
char *str = HEAP_STRING_AS_C_STRING(arg);
PROCESS_INFORMATION pi;
STARTUPINFO si;
BOOL fSuccess;
ZeroMemory (&si,sizeof(si));
si.cb = sizeof(si);
fSuccess = CreateProcess (NULL,str,NULL,NULL,FALSE,0,NULL,NULL,&si,&pi);
if (fSuccess) {
HANDLE hProcess = pi.hProcess;
CloseHandle (pi.hThread);
return make_one_word_unt(task, (Vunt) hProcess );
}
return make_one_word_unt(task, (Vunt) 0 );
}
/* _lib7_win32_PS_get_environment_variable : String -> String option
* var
*
*/
Val _lib7_win32_PS_get_environment_variable(Task *task, Val arg)
{
#define GEV_BUF_SZ 4096
char buf[GEV_BUF_SZ];
int ret = GetEnvironmentVariable(HEAP_STRING_AS_C_STRING(arg),buf,GEV_BUF_SZ);
Val ml_s;
if (ret > GEV_BUF_SZ) {
return RAISE_SYSERR__MAY_HEAPCLEAN(task,-1,NULL);
}
if (ret > 0) {
ml_s = make_ascii_string_from_c_string__may_heapclean(task,buf,NULL);
return OPTION_THE( task, ml_s );
}
return OPTION_NULL;
#undef GEV_BUF_SZ
}
/* _lib7_win32_PS_get_environment_variable : String -> String option
* var
*
*/
Val _lib7_win32_PS_get_environment_variable(Task *task, Val arg)
{
#define GEV_BUF_SZ 4096
char buf[GEV_BUF_SZ];
int ret = GetEnvironmentVariable(HEAP_STRING_AS_C_STRING(arg),buf,GEV_BUF_SZ);
Val ml_s,res = OPTION_NULL;
if (ret > GEV_BUF_SZ) {
return RAISE_SYSERR(task,-1);
}
if (ret > 0) {
ml_s = make_ascii_string_from_c_string(task,buf);
OPTION_THE(task,res,ml_s);
}
return res;
#undef GEV_BUF_SZ
}
Val _lib7_Sock_to_log (Task* task, Val arg) {
//===============================================
//
// Mythryl type: String -> Void
//
// Write string to currently open logfile via log_if from
//
// src/c/main/error-reporting.c
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
char* string = HEAP_STRING_AS_C_STRING( arg );
log_if ("%s", string); // Safer than doing just log_if(string) -- the string might have a '%' in it.
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return HEAP_VOID;
}
Val _lib7_P_FileSys_unlink (Task* task, Val arg) {
//======================
//
// Mythryl type: String -> Void
//
// Remove directory entry
//
// This fn gets bound as unlink in:
//
// src/lib/std/src/psx/posix-file.pkg
// src/lib/std/src/psx/posix-file-system-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int status;
char* heap_path = HEAP_STRING_AS_C_STRING( arg );
// 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->hostthread, __func__, NULL );
//
status = unlink( c_path );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
unbuffer_mythryl_heap_value( &path_buf );
}
Val result = RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
/* _lib7_win32_PS_create_process : String -> one_word_unt
*
* Note: This function returns the handle to the created process
* This handle will need to be freed before the system releases
* the memory associated to the process.
* We will take care of this in the wait_for_single_chunk
* call. This is for the time being only used by threadkit.
* It could also cause problems later on.
*/
Val _lib7_win32_PS_create_process(Task *task, Val arg)
{
char *str = HEAP_STRING_AS_C_STRING(arg);
PROCESS_INFORMATION pi;
STARTUPINFO si;
Val res;
BOOL fSuccess;
ZeroMemory (&si,sizeof(si));
si.cb = sizeof(si);
fSuccess = CreateProcess (NULL,str,NULL,NULL,FALSE,0,NULL,NULL,&si,&pi);
if (fSuccess) {
HANDLE hProcess = pi.hProcess;
CloseHandle (pi.hThread);
WORD_ALLOC (task,res,(Val_Sized_Unt)hProcess);
return res;
}
WORD_ALLOC (task,res,(Val_Sized_Unt)0);
return res;
}
Val _lib7_P_ProcEnv_getenv (Task* task, Val arg) {
//======================
//
// Mythryl type: String -> Null_Or(String)
//
// Return value for environment name
//
// This fn gets bound as getenv in:
//
// src/lib/std/src/posix-1003.1b/posix-id.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_ProcEnv_getenv");
char* status;
// 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 key_buf;
{
char* heap_key = HEAP_STRING_AS_C_STRING( arg );
char* c_key
=
buffer_mythryl_heap_value( &key_buf, (void*) heap_key, strlen( heap_key ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_ProcEnv_getenv", NULL );
//
status = getenv( c_key );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_ProcEnv_getenv" );
unbuffer_mythryl_heap_value( &key_buf );
}
if (status == NULL) return OPTION_NULL;
Val s = make_ascii_string_from_c_string__may_heapclean( task, status, NULL); // make_ascii_string_from_c_string__may_heapclean def in src/c/heapcleaner/make-strings-and-vectors-etc.c
return OPTION_THE( task, s );
}
Val _lib7_P_FileSys_mkfifo (Task* task, Val arg) {
//======================
//
// Mythryl type: (String, Unt) -> Void
// name mode
//
// Make a FIFO special file.
//
// This fn gets bound as make_pipe' in:
//
// src/lib/std/src/posix-1003.1b/posix-file.pkg
//
// This fn gets bound as make_fifo' in:
//
// src/lib/std/src/posix-1003.1b/posix-file-system-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_FileSys_mkfifo");
int status;
Val path = GET_TUPLE_SLOT_AS_VAL( arg, 0);
mode_t mode = TUPLE_GETWORD( arg, 1);
//
char* heap_path = HEAP_STRING_AS_C_STRING( path );
//
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_mkfifo", NULL );
//
status = mkfifo (c_path, mode);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_mkfifo" );
unbuffer_mythryl_heap_value( &path_buf );
}
RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
}
/* _lib7_OpenCV_cvLoadImage : String -> Image
*
*/
Val
_lib7_OpenCV_cvLoadImage (Task *task, Val arg)
{
#if HAVE_OPENCV_CV_H && HAVE_LIBCV
char* filename = HEAP_STRING_AS_C_STRING( arg );
IplImage* ipl_image = cvLoadImage( filename, CV_LOAD_IMAGE_UNCHANGED );
if (!ipl_image) RAISE_ERROR(task, "cvLoadImage returned NULL");
{
// Copy image into heap, so that it can be
// garbage-collected when no longer needed:
//
Val header; Val header_data;
Val image; Val image_data;
Val result;
header_data = make_int2_vector_sized_in_bytes( task, ipl_image, sizeof(IplImage));
SEQHDR_ALLOC(task, header, UNT8_RO_VECTOR_TAGWORD, header_data, sizeof(IplImage));
c_roots__global[c_roots_count__global++] = &header; // Protect header from garbage collection while allocating image.
image_data = make_int2_vector_sized_in_bytes( task, ipl_image->imageData, ipl_image->imageSize);
SEQHDR_ALLOC(task, image, UNT8_RO_VECTOR_TAGWORD, image_data, ipl_image->imageSize);
--c_roots_count__global;
cvReleaseImage( &ipl_image );
REC_ALLOC2(task, result, header, image);
return result;
}
#else
extern char* no_opencv_support_in_runtime;
return RAISE_ERROR(task, no_opencv_support_in_runtime);
#endif
}
Val _lib7_P_ProcEnv_sysconf (Task* task, Val arg) {
//=======================
//
// Mythryl type: String -> Unt
//
// Get configurable system variables
//
// This fn gets bound as sysconf in:
//
// src/lib/std/src/posix-1003.1b/posix-process.pkg
name_val_t* attribute = _lib7_posix_nv_lookup(HEAP_STRING_AS_C_STRING(arg), values, NUMELMS);
//
if (!attribute) {
//
errno = EINVAL;
return RAISE_SYSERR(task, -1);
}
long val;
errno = 0;
//
while (((val = sysconf(attribute->val)) == -1) && (errno == EINTR)) {
errno = 0;
continue;
}
if (val >= 0) {
//
Val result;
WORD_ALLOC (task, result, val);
return result;
}
if (errno == 0) return RAISE_ERROR(task, "unsupported POSIX feature");
else return RAISE_SYSERR(task, -1);
}
Val _lib7_Sig_ascii_signal_name_to_portable_signal_id (Task* task, Val arg) {
//=================================================
//
// Mythryl type: String -> Int
//
// This fn gets bound as ascii_signal_name_to_portable_signal_id in:
//
// src/lib/std/src/nj/interprocess-signals-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
char* signal_name = HEAP_STRING_AS_C_STRING( arg );
//
int signal_id = ascii_signal_name_to_portable_signal_id ( signal_name ); // ascii_name_to_portable_signal_id is from src/c/machine-dependent/interprocess-signals.c
//
Val result = TAGGED_INT_FROM_C_INT( signal_id );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
