Val _lib7_P_IO_read (Task* task, Val arg) {
//===============
//
// Mythryl type: (Int, Int) -> vector_of_one_byte_unts::Vector
// fd nbytes
//
// Read the specified number of bytes from the specified file,
// returning them in a vector.
//
// This fn gets bound as read' in:
//
// src/lib/std/src/psx/posix-io.pkg
// src/lib/std/src/psx/posix-io-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
Val vec;
int n;
int fd = GET_TUPLE_SLOT_AS_INT( arg, 0 );
int nbytes = GET_TUPLE_SLOT_AS_INT( arg, 1 );
if (nbytes == 0) return ZERO_LENGTH_STRING__GLOBAL;
// 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 allocate C space in which to do the read:
//
Mythryl_Heap_Value_Buffer vec_buf;
//
{ char* c_vec = buffer_mythryl_heap_nonvalue( &vec_buf, nbytes ); // buffer_mythryl_heap_nonvalue is from src/c/main/runtime-state.c
do {
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
n = read (fd, c_vec, nbytes);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
//
} while (n < 0 && errno == EINTR); // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
if (n < 0) { unbuffer_mythryl_heap_value( &vec_buf ); return RAISE_SYSERR__MAY_HEAPCLEAN(task, n, NULL); }
if (n == 0) { unbuffer_mythryl_heap_value( &vec_buf ); return ZERO_LENGTH_STRING__GLOBAL; }
// Allocate the vector.
// Note that this might trigger a heapcleaning, moving things around:
//
vec = allocate_nonempty_wordslots_vector__may_heapclean( task, BYTES_TO_WORDS(n), NULL );
memcpy( PTR_CAST(char*, vec), c_vec, n );
unbuffer_mythryl_heap_value( &vec_buf );
}
Val result = make_vector_header(task, STRING_TAGWORD, vec, n);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
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;
}
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_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_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_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_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_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_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_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;
}
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);
}
Val _lib7_netdb_get_host_by_name (Task* task, Val arg) {
//============================
//
// Mythryl type: String -> Null_Or( (String, List(String), Raw_Address_Family, List( Internet_Address )) )
//
// This fn gets bound as get_host_by_name' in:
//
// src/lib/std/src/socket/dns-host-lookup.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_netdb_get_host_by_name");
char* heap_name = HEAP_STRING_AS_C_STRING( arg ); // Last use of 'arg'.
struct hostent* result;
// 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* 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_netdb_get_host_by_name", NULL );
//
result = gethostbyname( c_name );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_netdb_get_host_by_name" );
unbuffer_mythryl_heap_value( &name_buf );
}
return _util_NetDB_mkhostent (task, result); // _util_NetDB_mkhostent def in src/c/lib/socket/util-mkhostent.c
}
Val _lib7_P_FileSys_chdir (Task* task, Val arg) {
//=====================
//
// Mythryl type: String -> Void
//
// Change working directory.
//
// This fn gets bound as change_directory 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_chdir");
int status;
char* heap_dir = 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 dir_buf;
//
{ char* c_dir = buffer_mythryl_heap_value( &dir_buf, (void*) heap_dir, strlen( heap_dir )+1 ); // '+1' for terminal NUL on string.
//
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_chdir", NULL );
//
status = chdir( c_dir );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_chdir" );
//
unbuffer_mythryl_heap_value( &dir_buf );
}
RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
}
Val _lib7_P_IO_copy (Task* task, Val arg) {
//===============
//
// Mythryl type: (String, String) -> Int
//
// Copy a file and return its length.
//
// This fn gets bound as copy in:
//
// src/lib/std/src/psx/posix-io.pkg
// src/lib/std/src/psx/posix-io-64.pkg # Actually, I haven't gotten around to this yet.
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
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_path into C storage:
//
Mythryl_Heap_Value_Buffer existing_buf;
Mythryl_Heap_Value_Buffer new_name_buf;
int ok = TRUE;
ssize_t total_bytes_written = 0;
{ 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 );
//
struct stat statbuf;
int fd_out;
int fd_in = open(c_existing, O_RDONLY); // Open the input file.
if (fd_in >= 0) {
if (0 <= fstat(fd_in, &statbuf)) { // Get the mode of the input file so that we can ...
fd_out = creat( c_new_name, statbuf.st_mode ); // ... open the output file with same mode as input file.
if (0 <= fd_out) {
char buffer[ 4096 ];
ssize_t bytes_read;
int ok = TRUE;
while (ok) { // Read up to one buffer[]-load from fd_in.
do {
bytes_read = read( fd_in, buffer, 4096 );
} while (bytes_read < 0 && errno == EINTR); // Retry if interrupted by SIGALRM or such.
if (bytes_read < 0) {
ok = FALSE;
break;
}
if (bytes_read == 0) {
break;
}
ssize_t buffer_bytes_written = 0;
while (ok && (buffer_bytes_written < bytes_read)) { // Write buffer[] contents to fd_out. Usually one write() will do it, but this is not guaranteed.
ssize_t bytes_to_write = bytes_read - buffer_bytes_written;
ssize_t bytes_written;
do {
bytes_written = write( fd_out, buffer+buffer_bytes_written, bytes_to_write );
} while (bytes_written < 0 && errno == EINTR); // Retry if interrupted by SIGALRM or such.
ok = ok && (bytes_written > 0);
buffer_bytes_written += bytes_written;
total_bytes_written += bytes_written;
}
}
close(fd_out);
} else {
ok = FALSE;
}
close(fd_in);
} else {
ok = FALSE;
}
} else {
ok = FALSE;
}
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
unbuffer_mythryl_heap_value( &existing_buf );
unbuffer_mythryl_heap_value( &new_name_buf );
}
Val result;
if (!ok) result = RAISE_SYSERR__MAY_HEAPCLEAN(task, -1, NULL); // XXX SUCKO FIXME I'm being totally sloppy about accurate diagnostics here. Feel free to submit a patch improving this.
else result = TAGGED_INT_FROM_C_INT( total_bytes_written );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_Sock_recvbuffrom (Task* task, Val arg) {
//======================
//
// Mythryl type: (Socket, rw_vector_of_one_byte_unts::Rw_Vector, Int, Int, Bool, Bool) -> (Int, Addr)
//
// The arguments are:
// socket,
// data buffer,
// start position,
// number of bytes,
// OOB flag
// peek flag.
//
// The result is:
// number of bytes read
// source address.
//
// This fn gets bound as recv_from_a in:
//
// src/lib/std/src/socket/socket-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
char address_buf[ MAX_SOCK_ADDR_BYTESIZE ];
socklen_t address_len = MAX_SOCK_ADDR_BYTESIZE;
int socket = GET_TUPLE_SLOT_AS_INT( arg, 0);
// Val buf = GET_TUPLE_SLOT_AS_VAL( arg, 1); // Mythryl buffer to read bytes into. // We'll fetch this after the call, since it may move around during the call.
int offset = GET_TUPLE_SLOT_AS_INT( arg, 2); // Offset within buf to read bytes into.
int nbytes = GET_TUPLE_SLOT_AS_INT( arg, 3); // Number of bytes to read.
int flag = 0;
int n;
if (GET_TUPLE_SLOT_AS_VAL(arg, 4) == HEAP_TRUE) flag |= MSG_OOB;
if (GET_TUPLE_SLOT_AS_VAL(arg, 5) == HEAP_TRUE) flag |= MSG_PEEK;
// 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 allocate a C-side read buffer:
//
Mythryl_Heap_Value_Buffer readbuf_buf;
//
{ char* c_readbuf = buffer_mythryl_heap_nonvalue( &readbuf_buf, nbytes );
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, &arg ); // 'arg' is still live here!
//
do {
//
n = recvfrom( socket,
c_readbuf,
nbytes,
flag,
(struct sockaddr *)address_buf,
&address_len
);
} while (n < 0 && errno == EINTR); // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
if (n < 0) {
unbuffer_mythryl_heap_value( &readbuf_buf );
return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
}
Val buf = GET_TUPLE_SLOT_AS_VAL( arg, 1); // Mythryl buffer to read bytes into.
char* bufstart = HEAP_STRING_AS_C_STRING(buf) + offset;
memcpy( bufstart, c_readbuf, n);
unbuffer_mythryl_heap_value( &readbuf_buf );
}
Val data = make_biwordslots_vector_sized_in_bytes__may_heapclean( task, address_buf, address_len, NULL );
Val address = make_vector_header( task, UNT8_RO_VECTOR_TAGWORD, data, address_len);
Val result = make_two_slot_record(task, TAGGED_INT_FROM_C_INT(n), address);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_Sock_recv (Task* task, Val arg) {
//===============
//
// Mythryl type: (Socket, Int, Bool, Bool) -> vector_of_one_byte_unts::Vector
//
// The arguments are: socket, number of bytes, OOB flag and peek flag.
// The result is the vector of bytes received.
//
// This fn gets bound as recv_v' in:
//
// src/lib/std/src/socket/socket-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
Val vec;
ssize_t n;
int socket = GET_TUPLE_SLOT_AS_INT( arg, 0 );
int nbytes = GET_TUPLE_SLOT_AS_INT( arg, 1 );
Val oob = GET_TUPLE_SLOT_AS_VAL( arg, 2 );
Val peek = GET_TUPLE_SLOT_AS_VAL( arg, 3 );
int flag = 0;
if (oob == HEAP_TRUE) flag |= MSG_OOB;
if (peek == HEAP_TRUE) flag |= MSG_PEEK;
// 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 allocate a C-world buffer
// to read the bytes into:
//
Mythryl_Heap_Value_Buffer read_buf;
//
{ unsigned char* c_read = buffer_mythryl_heap_nonvalue( &read_buf, nbytes );
// log_if("recv.c/before: socket d=%d nbytes d=%d oob=%s peek=%s\n",socket,nbytes,(oob == HEAP_TRUE)?"TRUE":"FALSE",(peek == HEAP_TRUE)?"TRUE":"FALSE");
errno = 0;
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
do { // Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c
// // Restored 2012-08-07 CrT
n = recv (socket, c_read, nbytes, flag);
//
} while (n < 0 && errno == EINTR); // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
if (n <= 0) {
unbuffer_mythryl_heap_value( &read_buf );
if (n < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
if (n == 0) return ZERO_LENGTH_STRING__GLOBAL;
}
// Allocate result vector to hold the bytes read.
// NB: This might cause a heapcleaning, moving things around:
//
vec = allocate_nonempty_wordslots_vector__may_heapclean( task, BYTES_TO_WORDS(n), NULL );
// Copy bytes read into result vector:
//
memcpy( PTR_CAST(char*, vec), c_read, n);
// log_if( "recv.c/after: n d=%d errno d=%d (%s)\n", n, errno, errno ? strerror(errno) : "");
// hexdump_if( "recv.c/after: Received data: ", PTR_CAST(unsigned char*, vec), n );
unbuffer_mythryl_heap_value( &read_buf );
}
Val result = make_vector_header( task, STRING_TAGWORD, vec, n );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_FileSys_utime (Task* task, Val arg) {
//=====================
//
// Mythryl type: (String, one_word_int::Int, one_word_int::Int) -> Void
// name actime modtime
//
// Sets file access and modification times.
// If actime = -1, then set both to current time.
//
// This fn gets bound as utime' 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);
time_t actime = TUPLE_GET_INT1( arg, 1);
time_t modtime = TUPLE_GET_INT1( 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*) heap_path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
if (actime == -1) {
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = utime( c_path, NULL );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
} else {
struct utimbuf tb;
tb.actime = actime;
tb.modtime = modtime;
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = utime( c_path, &tb );
//
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_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;
}
Val _lib7_Sock_sendbuf (Task* task, Val arg) {
//==================
//
// Mythryl type:
// ( Int, # socket fd
// Wy8Vector, # byte vector
// Int, # start offset
// Int, # vector length (end offset)
// Bool, # don't-route flag
// Bool # default-oob flag
// )
// ->
// Int
//
// Send data from the buffer; bytes is either a rw_vector_of_one_byte_unts.Rw_Vector, or
// a vector_of_one_byte_unts.vector. The arguments are: socket, data buffer, start
// position, number of bytes, OOB flag, and don't_route flag.
//
// This fn gets bound as send_v, send_a in:
//
// src/lib/std/src/socket/socket-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int socket = GET_TUPLE_SLOT_AS_INT( arg, 0);
Val buf = GET_TUPLE_SLOT_AS_VAL( arg, 1);
int offset = GET_TUPLE_SLOT_AS_INT( arg, 2);
int nbytes = GET_TUPLE_SLOT_AS_INT( arg, 3);
Val oob = GET_TUPLE_SLOT_AS_VAL( arg, 4);
Val dontroute = GET_TUPLE_SLOT_AS_VAL( arg, 5); // Last use of 'arg'.
char* heap_data = HEAP_STRING_AS_C_STRING(buf) + offset;
// Compute flags parameter:
//
int flgs = 0;
if (oob == HEAP_TRUE) flgs |= MSG_OOB;
if (dontroute == HEAP_TRUE) flgs |= MSG_DONTROUTE;
// log_if( "sendbuf.c/top: socket d=%d nbytes d=%d OOB=%s DONTROUTE=%s\n",
// socket, nbytes, (oob == HEAP_TRUE) ? "TRUE" : "FALSE", (dontroute == HEAP_TRUE) ? "TRUE" : "FALSE"
// );
// hexdump_if( "sendbuf.c/top: Data to send: ", (unsigned char*)heap_data, nbytes );
errno = 0;
int 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 );
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
do {
//
n = send (socket, c_data, nbytes, flgs);
//
} while (n < 0 && errno == EINTR); // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
// log_if( "sendbuf.c/bot: n d=%d errno d=%d\n", n, errno );
unbuffer_mythryl_heap_value( &data_buf );
}
Val result = RETURN_STATUS_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, n, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}