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; }