Val _util_NetDB_mkservent (Task* task, struct servent* sentry) {
//=====================
//
// Mythryl type:
//
// Allocate an Lib7 value of type:
// Null_Or( (String, List(String), Int, String) )
// to represent a struct servent value. Note that the port number is returned
// in network byteorder, so we need to map it to host order.
if (sentry == NULL) return OPTION_NULL;
// If our agegroup0 buffer is more than half full,
// empty it by doing a heapcleaning. This is very
// conservative -- which is the way I like it. :-)
//
if (agegroup0_freespace_in_bytes( task )
< agegroup0_usedspace_in_bytes( task )
){
call_heapcleaner( task, 0 );
}
// Build the return result:
Val name = make_ascii_string_from_c_string__may_heapclean( task, sentry->s_name, NULL ); Roots roots1 = { &name, NULL };
Val aliases = make_ascii_strings_from_vector_of_c_strings__may_heapclean( task, sentry->s_aliases, &roots1); Roots roots2 = { &aliases, &roots1 };
Val proto = make_ascii_string_from_c_string__may_heapclean( task, sentry->s_proto, &roots2); // Roots roots3 = { &proto, &roots2 };
Val port = TAGGED_INT_FROM_C_INT( ntohs(sentry->s_port) );
Val result = make_four_slot_record(task, name, aliases, port, proto);
return OPTION_THE( task, 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 _util_NetDB_mknetent (Task *task, struct netent* nentry) {
//====================
//
// Allocate a Mythryl value of type
// Null_Or( (String, List(String), Addr_Family, Sysword) )
// to represent a struct netent value.
if (nentry == NULL) return OPTION_NULL;
// Build the return result:
// If our agegroup0 buffer is more than half full,
// empty it by doing a heapcleaning. This is very
// conservative -- which is the way I like it. :-)
//
if (agegroup0_freespace_in_bytes( task )
< agegroup0_usedspace_in_bytes( task )
){
call_heapcleaner( task, 0 );
}
Val name = make_ascii_string_from_c_string__may_heapclean( task, nentry->n_name, NULL ); Roots roots1 = { &name, NULL };
Val aliases = make_ascii_strings_from_vector_of_c_strings__may_heapclean( task, nentry->n_aliases, &roots1 ); Roots roots2 = { &aliases, &roots1 };
Val af = make_system_constant__may_heapclean( task, &_Sock_AddrFamily, nentry->n_addrtype, &roots2 ); // Roots roots3 = { &af, &roots2 };
Val net = make_one_word_unt( task, (Vunt) (nentry->n_net) ); // Roots roots4 = { &net, &roots3 };
Val result = make_four_slot_record( task, name, aliases, af, net );
return OPTION_THE( task, result );
}
Val _lib7_netdb_get_protocol_by_number (Task* task, Val arg) {
//==================================
//
// Mythryl type: Int -> Null_Or( (String, List(String), Int) )
//
// This fn gets bound as get_prot_by_number' in:
//
// src/lib/std/src/socket/net-protocol-db.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int number = TAGGED_INT_TO_C_INT( arg ); // Last use of 'arg'.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
struct protoent* pentry = getprotobynumber( number );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
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_Error_errmsg (Task* task, Val arg) {
//====================
//
// Mythryl type: Int -> String
//
// Return the OS-dependent error message associated with error.
//
// This fn gets bound as errmsg in:
//
// src/lib/std/src/psx/posix-error.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int errnum = TAGGED_INT_TO_C_INT( arg );
Val result;
#if defined( HAS_STRERROR )
//
char* msg = strerror( errnum );
//
if (msg != 0) {
//
result = make_ascii_string_from_c_string__may_heapclean( task, msg, NULL ); // make_ascii_string_from_c_string__may_heapclean def in src/c/heapcleaner/make-strings-and-vectors-etc.c
} else {
char buf[64];
sprintf( buf, "<unknown error %d>", errnum); // XXX SUCKO FIXME should use a modern fn proof against buffer overrun.
result = make_ascii_string_from_c_string__may_heapclean (task, buf, NULL );
}
#else
if (0 <= errnum && errnum < sys_nerr) {
//
result = make_ascii_string_from_c_string__may_heapclean (task, sys_errlist[errnum], NULL );
//
} else {
//
char buf[64];
snprintf( buf, 64, "<unknown error %d>", errnum);
result = make_ascii_string_from_c_string__may_heapclean (task, buf, NULL );
}
#endif
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_FileSys_readdir (Task* task, Val arg) {
//=======================
//
// Mythryl type: Ckit_Dirstream -> String
//
// Return the next filename from the directory stream.
//
// This fn gets bound as readdir' 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__);
struct dirent* dirent;
while (TRUE) {
errno = 0;
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
dirent = readdir(PTR_CAST(DIR*, arg)); // Note that 'arg' points into the C heap not the Mythryl heap -- check src/c/lib/posix-file-system/opendir.c
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
Val result;
if (dirent == NULL) {
if (errno != 0) result = RAISE_SYSERR__MAY_HEAPCLEAN(task, -1, NULL); // Error occurred.
else result = ZERO_LENGTH_STRING__GLOBAL; // End of stream.
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
} else {
char *cp = dirent->d_name;
// SML/NJ drops "." and ".." at this point,
// but that is alien to posix culture,
// so I've commented it out: -- 2008-02-23 CrT
//
// if ((cp[0] == '.')
// && ((cp[1] == '\0') || ((cp[1] == '.') && (cp[2] == '\0'))))
// continue;
// else
//
result = make_ascii_string_from_c_string__may_heapclean (task, cp, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
}
}
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_U_Dynload_dlerror (Task* task, Val lib7_handle) { // : Void -> Null_Or(String)
//=======================
//
// Extract error after unsuccessful dlopen/dlsym/dlclose.
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
const char* e = dlerror ();
Val result;
if (e == NULL) result = OPTION_NULL;
else result = OPTION_THE( task, make_ascii_string_from_c_string__may_heapclean(task, e, NULL) );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
/* _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
}
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 );
}
static Val do_get_script_name (Task* task, Val arg) {
// ==================
//
// Mythryl type: Void -> Null_Or( String )
//
// If MYTHRYL_SCRIPT was set in the Posix "environment"
// when the Mythryl C runtime started up, this call will
// return its string value, otherwise NULL.
//
// The C runtime removes MYTHRYL_SCRIPT from the environment
// immediately after checking for it (and caching its value)
// because if it is left in the environment and then inherited
// by a spawned subprocess it can cause totally unexpected
// behavior in violent violation of the Principle of Least
// Surprise. (Hue White encountered this.)
//
// The MYTHRYL_SCRIPT thing remains an unholy kludge, but
// this at least minimizes the kludges window of opportunity
// to cause mayhem.
//
// This fn gets bound to 'get_script_name' in:
//
// src/lib/src/kludge.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
if (!mythryl_script__global) { // mythryl_script__global is from src/c/main/runtime-main.c
//
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return OPTION_NULL; // OPTION_NULL is from src/c/h/make-strings-and-vectors-etc.h
}
Val script_name
=
make_ascii_string_from_c_string__may_heapclean( task, mythryl_script__global, NULL );
Val result = OPTION_THE(task, script_name);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_netdb_get_host_name (Task* task, Val arg) {
//=========================
//
// Mythryl type: Void -> String
//
// This fn gets bound as get_host_name in:
//
// src/lib/std/src/socket/dns-host-lookup.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_netdb_get_host_name");
char hostname[ MAXHOSTNAMELEN ];
RELEASE_MYTHRYL_HEAP( task->pthread, "", NULL );
//
if (gethostname( hostname, MAXHOSTNAMELEN ) == -1) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "" );
return make_ascii_string_from_c_string__may_heapclean( task, hostname, NULL );
}
Val _lib7_OS_tmpname (Task* task, Val arg) {
//================
//
// Generate a unique name for a temporary file.
//
// Mythryl type: Void -> String
//
// This fn gets bound as tmp_name in:
//
// src/lib/std/src/posix/winix-file.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
static int call_number = 0;
static int pid = 0;
char buf[ 132 ];
int c1 = ++call_number; // Try to make our filename unique.
if (!pid) {
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
pid = getpid(); // Try to harder to make our filename unique.
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
}
int c2 = ++call_number; // Try to harder yet to make our filename unique. :-)
sprintf (buf, "tmpfile.%d.%d.%d.tmp", c1, pid, c2);
//
Val result = make_ascii_string_from_c_string__may_heapclean (task, buf, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
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;
}
Val raise_error__may_heapclean (
//==========================
//
Task* task,
const char* altMsg,
const char* at, // C sourcefile and line number raising this error: "<foo.c:37>"
Roots* extra_roots
) {
// Raise the Mythryl exception RUNTIME_EXCEPTION, which is defined as:
//
// exception RUNTIME_EXCEPTION (String, Null_Or(System_Error) );
//
// We normally get invoked via either the
// RAISE_SYSERR__MAY_HEAPCLEAN or RAISE_ERROR__MAY_HEAPCLEAN macro from
//
// src/c/lib/raise-error.h
//
// For the time being, we use the errno value as the System_Error; eventually that
// will be represented by an (Int, String) pair. If alt_msg is non-zero,
// then use it as the error string and use NULL for the System_Error.
int error_number = errno; // Various calls can trash this value so preserve it early.
const char* msg;
char buf[32];
Val null_or_errno;
if (altMsg != NULL) {
//
msg = altMsg;
null_or_errno = OPTION_NULL;
} else if ((msg = strerror(error_number)) != NULL) {
null_or_errno = OPTION_THE( task, TAGGED_INT_FROM_C_INT(error_number) );
} else {
sprintf(buf, "<unknown error %d>", error_number);
msg = buf;
null_or_errno = OPTION_THE( task, TAGGED_INT_FROM_C_INT(error_number) );
}
#if (defined(DEBUG_OS_INTERFACE) || defined(DEBUG_TRACE_CCALL))
debug_say ("RaiseSysError: errno = %d, msg = \"%s\"\n",
(altMsg != NULL) ? -1 : error_number, msg);
#endif
Roots roots1 = { &null_or_errno, extra_roots };
Val errno_string = make_ascii_string_from_c_string__may_heapclean (task, msg, &roots1 );
Val at_list; // [] or [ "<foo.c:187>" ].
//
if (at != NULL) {
//
Roots roots2 = { &errno_string, &roots1 };
Val at_cstring
=
make_ascii_string_from_c_string__may_heapclean (task, at, &roots2 );
at_list = LIST_CONS(task, at_cstring, LIST_NIL);
} else {
at_list = LIST_NIL;
}
Val arg = make_two_slot_record( task, errno_string, null_or_errno);
Val syserr_exception = MAKE_EXCEPTION(task, PTR_CAST( Val, RUNTIME_EXCEPTION__GLOBAL), arg, at_list);
// Modify the task state so that 'syserr_exception'
// will be raised when Mythryl execution resumes:
//
raise_mythryl_exception( task, syserr_exception ); // raise_mythryl_exception is from src/c/main/run-mythryl-code-and-runtime-eventloop.c
return syserr_exception;
} // fun raise_error__may_heapclean
static Val read_in_compiled_file_list__may_heapclean (
// =========================================
//
Task* task,
const char* compiled_files_to_load_filename,
int* return_max_boot_path_len,
Roots* extra_roots
){
// Open given file and read from it the list of
// filenames of compiled_files to be later loaded.
// Return them as a Mythryl list of Mythryl strings:
#define BUF_LEN 1024 // "This should be plenty for two numbers." "640K should be enough for anyone."
char buf[ BUF_LEN ];
// Val* file_names = NULL;
char* name_buf = NULL;
int max_num_boot_files = MAX_NUMBER_OF_BOOT_FILES;
int max_boot_path_len = MAX_LENGTH_FOR_A_BOOTFILE_PATHNAME;
int file_count = 0;
FILE* list_fd = open_file( compiled_files_to_load_filename, FALSE );
fprintf (
stderr,
" load-compiledfiles.c: Reading file %s\n",
compiled_files_to_load_filename
);
if (log_fd) {
//
fprintf (
log_fd,
" load-compiledfiles.c: Reading file %s\n",
compiled_files_to_load_filename
);
}
Val file_list = LIST_NIL; Roots roots1 = { &file_list, extra_roots };
if (list_fd) {
// Read header:
//
for (;;) {
//
if (!fgets (buf, BUF_LEN, list_fd)) {
die (
"compiled_files_to_load file \"%s\" ends before end-of-header (first empty line)",
compiled_files_to_load_filename
);
}
{ char* p = buf;
while (*p == ' ' || *p == '\t') ++p; // Skip leading whitespace.
if (p[0] == '\n') break; // Header ends at first empty line.
if (p[0] == '#') continue; // Ignore comment lines.
if (strstr( p,"FILES=") == p) {
//
max_num_boot_files = strtoul(p+6, NULL, 0);
continue;
}
if (strstr(p,"MAX_LINE_LENGTH=") == p) {
//
max_boot_path_len = strtoul(p+16, NULL, 0) +2;
continue;
}
die (
"compiled_files_to_load file \"%s\" contains unrecognized header line \"%s\"",
compiled_files_to_load_filename,
p
);
}
}
if (max_num_boot_files < 0) {
//
die("compiled_files_to_load file \"%s\" contains negative files count?! (%d)",
compiled_files_to_load_filename,
max_num_boot_files
);
}
if (max_boot_path_len < 0) {
//
die("compiled_file_to_load file \"%s\" contains negative boot path len?! (%d)",
compiled_files_to_load_filename,
max_boot_path_len
);
}
*return_max_boot_path_len = max_boot_path_len; // Tell the calling function.
if (!(name_buf = MALLOC( max_boot_path_len ))) {
//
die ("unable to allocate space for .compiled file filenames");
}
// if (!(file_names = MALLOC( max_num_boot_files * sizeof(char*) ))) {
// //
// die ("Unable to allocate space for compiledfiles-to-load name table");
// }
// Read in the file names, converting them to
// Mythryl strings and saving them in a list:
//
while (fgets( name_buf, max_boot_path_len, list_fd )) {
// Skip leading whitespace:
//
char* p = name_buf;
while (*p == ' ' || *p == '\t') ++p;
// Ignore empty lines and comment lines:
//
if (*p == '\n') continue;
if (*p == '#') continue;
// Strip any trailing newline:
//
{ int j = strlen(p)-1;
//
if (p[j] == '\n') p[j] = '\0';
}
if (file_count >= max_num_boot_files) die ("too many files\n");
// If our agegroup0 buffer is more than half full,
// empty it by doing a heapcleaning. This is very
// conservative -- which is the way I like it. *grin*
//
if (agegroup0_freespace_in_bytes( task )
< agegroup0_usedspace_in_bytes( task )
){
call_heapcleaner_with_extra_roots( task, 0, &roots1 );
}
Val file_name = make_ascii_string_from_c_string__may_heapclean(task, p, &roots1 );
file_list = LIST_CONS(task, file_name, file_list);
}
if (name_buf) FREE( name_buf );
fclose( list_fd );
}
// Reverse filename list (to restore
// original order) and return it:
//
{ Val file_list2 = LIST_NIL; Roots roots2 = { &file_list2, &roots1 };
//
for (; file_list != LIST_NIL; file_list = LIST_TAIL(file_list)) {
//
Val file_name = LIST_HEAD(file_list);
//
file_list2 = LIST_CONS(task, file_name, file_list2);
// Again, if our agegroup0 buffer is more than
// half full, empty it by doing a heapcleaning:
//
if (agegroup0_freespace_in_bytes( task )
< agegroup0_usedspace_in_bytes( task )
){
call_heapcleaner_with_extra_roots( task, 0, &roots2 );
}
}
return file_list2;
}
}
Task* import_heap_image__may_heapclean (const char* fname, Heapcleaner_Args* params, Roots* extra_roots) {
// ================================
//
// This fn is called (only) by load_and_run_heap_image__may_heapclean in src/c/main/load-and-run-heap-image.c
//
Task* task;
Heapfile_Header image_header;
Heap_Header heap_header;
Val *externs;
Pthread_Image image;
Inbuf inbuf;
if (fname != NULL) {
//
// Resolve the name of the image.
// If the file exists use it, otherwise try the
// pathname with the machine ID as an extension.
if ((inbuf.file = fopen(fname, "rb"))) {
//
if (verbosity__global > 0) say("loading %s ", fname);
} else {
//
if ((inbuf.file = fopen(fname, "rb"))) {
//
if (verbosity__global > 0) say("loading %s ", fname);
} else {
die ("unable to open heap image \"%s\"\n", fname);
}
}
inbuf.needs_to_be_byteswapped = FALSE;
inbuf.buf = NULL;
inbuf.nbytes = 0;
} else {
//
// fname == NULL, so try to find
// an in-core heap image:
#if defined(DLOPEN) && !defined(OPSYS_WIN32)
//
void *lib = dlopen (NULL, RTLD_LAZY);
void *vimg, *vimglenptr;
if ((vimg = dlsym(lib,HEAP_IMAGE_SYMBOL )) == NULL) die("no in-core heap image found\n");
if ((vimglenptr = dlsym(lib,HEAP_IMAGE_LEN_SYMBOL)) == NULL) die("unable to find length of in-core heap image\n");
inbuf.file = NULL;
inbuf.needs_to_be_byteswapped = FALSE;
inbuf.base = vimg;
inbuf.buf = inbuf.base;
inbuf.nbytes = *(long*)vimglenptr;
#else
die("in-core heap images not implemented\n");
#endif
}
READ(&inbuf, image_header);
if (image_header.byte_order != ORDER) die ("incorrect byte order in heap image\n");
if (image_header.magic != IMAGE_MAGIC) die ("bad magic number (%#x) in heap image\n", image_header.magic);
if ((image_header.kind != EXPORT_HEAP_IMAGE) && (image_header.kind != EXPORT_FN_IMAGE)) die ("bad image kind (%d) in heap image\n", image_header.kind);
READ(&inbuf, heap_header);
// Check for command-line overrides of heap parameters:
//
if (params->agegroup0_buffer_bytesize == 0) {
params->agegroup0_buffer_bytesize = heap_header.agegroup0_buffer_bytesize;
}
if (params->active_agegroups < heap_header.active_agegroups) {
params->active_agegroups = heap_header.active_agegroups;
}
if (params->oldest_agegroup_retaining_fromspace_sibs_between_heapcleanings < 0) {
params->oldest_agegroup_retaining_fromspace_sibs_between_heapcleanings = heap_header.oldest_agegroup_retaining_fromspace_sibs_between_heapcleanings;
}
task = make_task( /*is_boot:*/FALSE, params ); // make_task def in src/c/main/runtime-state.c
// Get the run-time pointers into the heap:
//
*PTR_CAST( Val*, PERVASIVE_PACKAGE_PICKLE_LIST_REFCELL__GLOBAL )
=
heap_header.pervasive_package_pickle_list;
// This carefully constructed fake looks like a normal
// compiled package from the Mythryl side but actually
// links to compile C code -- see the hack in
//
// src/c/main/load-compiledfiles.c
//
runtime_package__global = heap_header.runtime_pseudopackage;
#ifdef ASM_MATH
mathvec__global = heap_header.math_package;
#endif
externs = heapio__read_externs_table (&inbuf); // Read the externals table.
READ(&inbuf, image); // Read and initialize the Mythryl state info.
//
if (image_header.kind == EXPORT_HEAP_IMAGE) {
// Load the live registers:
//
ASSIGN( POSIX_INTERPROCESS_SIGNAL_HANDLER_REFCELL__GLOBAL,
image.posix_interprocess_signal_handler
);
//
task->argument = image.stdArg;
task->fate = image.stdCont;
task->current_closure = image.stdClos;
task->program_counter = image.pc;
task->exception_fate = image.exception_fate;
task->current_thread = image.current_thread;
//
task->callee_saved_registers[0] = image.calleeSave[0];
task->callee_saved_registers[1] = image.calleeSave[1];
task->callee_saved_registers[2] = image.calleeSave[2];
read_heap (&inbuf, &heap_header, task, externs); // Read the Mythryl heap.
/* heapcleaner_messages_are_enabled__global = TRUE; */ // Heapcleaning messages are on by default for interactive images.
} else { // EXPORT_FN_IMAGE
// Restore the signal handler:
//
ASSIGN( POSIX_INTERPROCESS_SIGNAL_HANDLER_REFCELL__GLOBAL, image.posix_interprocess_signal_handler );
// Read the Mythryl heap:
//
task->argument = image.stdArg;
read_heap (&inbuf, &heap_header, task, externs);
// Initialize the calling context (taken from run_mythryl_function__may_heapclean): // run_mythryl_function__may_heapclean def in src/c/main/run-mythryl-code-and-runtime-eventloop.c
//
Val function_to_run = task->argument;
//
task->exception_fate = PTR_CAST( Val, handle_uncaught_exception_closure_v + 1 );
task->current_thread = HEAP_VOID;
//
task->fate = PTR_CAST( Val, return_to_c_level_c );
task->current_closure = function_to_run;
//
task->program_counter =
task->link_register = GET_CODE_ADDRESS_FROM_CLOSURE( function_to_run ); // Last use of 'function_to_run'.
// Set up the arguments to the imported function:
//
Val program_name = make_ascii_string_from_c_string__may_heapclean(task, mythryl_program_name__global, extra_roots); Roots roots1 = { &program_name, extra_roots };
//
Val args = make_ascii_strings_from_vector_of_c_strings__may_heapclean (task, commandline_args_without_argv0_or_runtime_args__global, &roots1 );
task->argument = make_two_slot_record( task, program_name, args );
// debug_say("arg = %#x : [%#x, %#x]\n", task->argument, GET_TUPLE_SLOT_AS_VAL(task->argument, 0), GET_TUPLE_SLOT_AS_VAL(task->argument, 1));
// Heapcleaner messages are off by
// default for spawn_to_disk images:
//
heapcleaner_messages_are_enabled__global = FALSE;
}
FREE( externs );
if (inbuf.file) fclose (inbuf.file);
if (verbosity__global > 0) say(" done\n");
return task;
} // fun import_heap_image__may_heapclean
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;
}
