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