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; }
/* do__negate_boolean * * opengl-client.api type: (Session, Bool) -> Bool * opengl-client-driver.api type: (Session, Bool) -> Bool */ static Val do__negate_boolean (Task* task, Val arg) { int b0 = GET_TUPLE_SLOT_AS_VAL( arg, 1) == HEAP_TRUE; int result = !b0; return result ? HEAP_TRUE : HEAP_FALSE; }
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_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_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_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_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_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_IO_fcntl_l (Task* task, Val arg) { //================== // // Mythryl type: (Int, Int, Flock_Rep) -> Flock_Rep // Flock_Rep = (Int, Int, Offset, Offset, Int) // // Handle record locking. // // This fn gets bound as fcntl_l in: // // src/lib/std/src/psx/posix-io.pkg ENTER_MYTHRYL_CALLABLE_C_FN(__func__); int fd = GET_TUPLE_SLOT_AS_INT( arg, 0 ); int cmd = GET_TUPLE_SLOT_AS_INT( arg, 1 ); Val flock_rep = GET_TUPLE_SLOT_AS_VAL( arg, 2 ); struct flock flock; int status; flock.l_type = GET_TUPLE_SLOT_AS_INT( flock_rep, 0 ); flock.l_whence = GET_TUPLE_SLOT_AS_INT( flock_rep, 1 ); flock.l_start = GET_TUPLE_SLOT_AS_INT( flock_rep, 2 ); flock.l_len = GET_TUPLE_SLOT_AS_INT( flock_rep, 3 ); do { // RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL ); // status = fcntl(fd, cmd, &flock); // RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ ); // } while (status < 0 && errno == EINTR); // Restart if interrupted by a SIGALRM or SIGCHLD or whatever. if (status < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL); Val result = make_five_slot_record( task, // TAGGED_INT_FROM_C_INT( flock.l_type ), TAGGED_INT_FROM_C_INT( flock.l_whence ), TAGGED_INT_FROM_C_INT( flock.l_start ), TAGGED_INT_FROM_C_INT( flock.l_len ), TAGGED_INT_FROM_C_INT( flock.l_pid ) ); EXIT_MYTHRYL_CALLABLE_C_FN(__func__); return result; }
/* do__open_window2 * * opengl-client.api type: { session: Session, wide: Int, high: Int, redbits: Int, greenbits: Int, bluebits: Int, alphabits: Int, depthbits: Int, stencilbits: Int, fullscreen: Bool } -> Bool * opengl-client-driver.api type: (Session, Int, Int, Int, Int, Int, Int, Int, Int, Bool) -> Bool */ static Val do__open_window2 (Task* task, Val arg) { int i0 = GET_TUPLE_SLOT_AS_INT( arg, 1); int i1 = GET_TUPLE_SLOT_AS_INT( arg, 2); int i2 = GET_TUPLE_SLOT_AS_INT( arg, 3); int i3 = GET_TUPLE_SLOT_AS_INT( arg, 4); int i4 = GET_TUPLE_SLOT_AS_INT( arg, 5); int i5 = GET_TUPLE_SLOT_AS_INT( arg, 6); int i6 = GET_TUPLE_SLOT_AS_INT( arg, 7); int i7 = GET_TUPLE_SLOT_AS_INT( arg, 8); int b8 = GET_TUPLE_SLOT_AS_VAL( arg, 9) == HEAP_TRUE; int result = glfwOpenWindow( /*wide*/i0, /*high*/i1, /*redbits*/i2, /*greenbits*/i3, /*bluebits*/i4, /*alphabits*/i5, /*depthbits*/i6, /*stencilbits*/i7, /*fullscreen*/b8 ? GLFW_FULLSCREEN : GLFW_WINDOW ); return result ? HEAP_TRUE : HEAP_FALSE; }
Val get_or_set_socket_nodelay_option (Task* task, Val arg) { //================================ // // Mythryl type: (Int, Null_Or(Bool)) -> Bool // // NOTE: this is a TCP level option, so we cannot use the utility function. // // This fn gets bound as ctl_delay in: // // src/lib/std/src/socket/internet-socket.pkg ENTER_MYTHRYL_CALLABLE_C_FN("get_or_set_socket_nodelay_option"); int socket = GET_TUPLE_SLOT_AS_INT( arg, 0 ); Val ctl = GET_TUPLE_SLOT_AS_VAL( arg, 1 ); // Last use of 'arg'. // Bool flag; int status; if (ctl == OPTION_NULL) { // socklen_t opt_size = sizeof(int); RELEASE_MYTHRYL_HEAP( task->pthread, "get_or_set_socket_nodelay_option", NULL ); // status = getsockopt (socket, IPPROTO_TCP, TCP_NODELAY, (sockoptval_t)&flag, &opt_size); // RECOVER_MYTHRYL_HEAP( task->pthread, "get_or_set_socket_nodelay_option" ); ASSERT((status < 0) || (opt_size == sizeof(int))); } else { flag = (Bool) TAGGED_INT_TO_C_INT(OPTION_GET(ctl)); RELEASE_MYTHRYL_HEAP( task->pthread, "get_or_set_socket_nodelay_option", NULL ); // status = setsockopt (socket, IPPROTO_TCP, TCP_NODELAY, (sockoptval_t)&flag, sizeof(int)); // RECOVER_MYTHRYL_HEAP( task->pthread, "get_or_set_socket_nodelay_option" ); } if (status < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL); else return (flag ? HEAP_TRUE : HEAP_FALSE); }
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); }
static int fetch_imports ( // ============= // Task* task, FILE* file, const char* filename, int next_import_record_slot_to_fill, Val tree_node ) { ////////////////////////////////////////////////////// // We are traversing a Mythryl heap tree of records // constituting the complete set of exported values // (functions, variables...) from some previously // loaded compiledfile external to the compiledfile // currently loading. // // Our task is to select from that tree those // values which are of interest to (imported by) // the compiledfile currently being loaded: We will // save these values in an import record being // constructed on the heap. // // Our guide is a list of 'kid_count' selectors // (slot numbers within tree_node) which we read // read from the compiledfile being loaded. // // If this list is empty, then 'tree_node' is // itself one of the values we're importing, // and we just save a pointer to it in the // import record and return. // // Otherwise, We do a recursive walk of some // subtree of the Lib7 record tree rooted at // 'tree_node', saving in the import record // each leaf visited. We read out of the compiledfile // a 'kid_count' long sequence of selectors giving // which children of 'tree_node' to recursively // visit, and call ourself recursively on each of // the thus-indicated children of 'tree_node. ////////////////////////////////////////////////////// // How many children of 'tree_node' should we visit? // Int1 kid_count = read_packed_int1 (file, filename); if (!kid_count) { // Save tree_node in the import record... // set_slot_in_nascent_heapchunk( task, next_import_record_slot_to_fill, tree_node ); ++ next_import_record_slot_to_fill; } else { // Recursively visit each of those children in turn: // while (kid_count --> 0) { // Which child should we visit next? // Int1 kid_selector = read_packed_int1( file, filename ); // Visit it: // next_import_record_slot_to_fill = fetch_imports ( task, file, filename, next_import_record_slot_to_fill, GET_TUPLE_SLOT_AS_VAL( tree_node, kid_selector ) ); } } return next_import_record_slot_to_fill; }
static Val picklehash_to_exports_tree (Picklehash* picklehash) { // ========================== // Val p; ////////////////////////////////////////////////////////////////////////////// // We identify a (particular version of) a compiledfile using // a 16-byte hash of its serialized ("pickled") form. // // Our global PERVASIVE_PACKAGE_PICKLE_LIST__GLOBAL is a singly // linked list with one entry for each compiledfile which // we have loaded into memory. // // Each entry in the list maps the picklehash naming that // compiledfile to the tree of values (functions etc) // exported by the compiledfile for use by other compiled_files. // // Here we look up the export tree associated with a given // picklehash by doing an O(N) scan down the linklist. // // XXX BUGGO FIXME It is criminally st00pid to be using an // O(N) lookup algorithm for a linklist which will often be // hundreds or even thousands of entries long, on which we // may be doing up to a million lookups. Especially when // the key comparisons are expensive. Can't we arrange to // use our standard redblack tree implementation here? ////////////////////////////////////////////////////////////////////////////// // For all compiled_files loaded into memory: // for (p = PERVASIVE_PACKAGE_PICKLE_LIST__GLOBAL; p != HEAP_VOID; p = GET_TUPLE_SLOT_AS_VAL(p, 2)) { // If the picklehash on this record // matches our search key picklehash... // Val id = GET_TUPLE_SLOT_AS_VAL(p, 0); if (memcmp( (char*) picklehash, HEAP_STRING_AS_C_STRING(id), PICKLEHASH_BYTES) == 0) { // ... then return its matching export tree: // return GET_TUPLE_SLOT_AS_VAL(p, 1); } } // If we get here, something is badly broken: // We should never be asked to find a picklehash // which isn't in the list -- all COMPILED_FILES_TO_LOAD // lists are supposed to be topologically sorted by // dependencies, so we never load an compiledfile until // we've loaded every compiledfile it depends upon. // { char buf[ PICKLEHASH_BYTES * 4 ]; // picklehash_to_hex_string( buf, PICKLEHASH_BYTES * 4, picklehash ); // die ("unable to find picklehash (compiledfile identifier) '%s'", buf); // Doesn't return. } exit(1); // Redundant -- just to suppress gcc warning. }
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 get_or_set_socket_linger_option (Task* task, Val arg) { //=============================== // // Mythryl type: (Socket_Fd, Null_Or(Null_Or(Int))) -> Null_Or(Int) // // Set/get the SO_LINGER option as follows: // NULL => get current setting // THE(NULL) => disable linger // THE(THE t) => enable linger with timeout t. // // This function gets bound as ctl_linger 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 ctl = GET_TUPLE_SLOT_AS_VAL( arg, 1 ); // Last use of 'arg'. struct linger optVal; int status; if (ctl == OPTION_NULL) { // socklen_t optSz = sizeof( struct linger ); RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL ); // status = getsockopt( socket, SOL_SOCKET, SO_LINGER, (sockoptval_t)&optVal, &optSz ); // RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ ); ASSERT( status < 0 || optSz == sizeof( struct linger )); // } else { // ctl = OPTION_GET(ctl); if (ctl == OPTION_NULL) { optVal.l_onoff = 0; // Argument is THE(NULL); disable linger. } else { optVal.l_onoff = 1; // argument is THE t; enable linger. optVal.l_linger = TAGGED_INT_TO_C_INT(OPTION_GET(ctl)); } RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL ); // status = setsockopt (socket, SOL_SOCKET, SO_LINGER, (sockoptval_t)&optVal, sizeof(struct linger)); // RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ ); } if (status < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL); if (optVal.l_onoff == 0) return OPTION_NULL; Val result = OPTION_THE( task, TAGGED_INT_FROM_C_INT( optVal.l_linger ) ); 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_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_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; }