Val _lib7_P_IO_read (Task* task, Val arg) {
//===============
//
// Mythryl type: (Int, Int) -> vector_of_one_byte_unts::Vector
// fd nbytes
//
// Read the specified number of bytes from the specified file,
// returning them in a vector.
//
// This fn gets bound as read' in:
//
// src/lib/std/src/psx/posix-io.pkg
// src/lib/std/src/psx/posix-io-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
Val vec;
int n;
int fd = GET_TUPLE_SLOT_AS_INT( arg, 0 );
int nbytes = GET_TUPLE_SLOT_AS_INT( arg, 1 );
if (nbytes == 0) return ZERO_LENGTH_STRING__GLOBAL;
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so allocate C space in which to do the read:
//
Mythryl_Heap_Value_Buffer vec_buf;
//
{ char* c_vec = buffer_mythryl_heap_nonvalue( &vec_buf, nbytes ); // buffer_mythryl_heap_nonvalue is from src/c/main/runtime-state.c
do {
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
n = read (fd, c_vec, nbytes);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
//
} while (n < 0 && errno == EINTR); // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
if (n < 0) { unbuffer_mythryl_heap_value( &vec_buf ); return RAISE_SYSERR__MAY_HEAPCLEAN(task, n, NULL); }
if (n == 0) { unbuffer_mythryl_heap_value( &vec_buf ); return ZERO_LENGTH_STRING__GLOBAL; }
// Allocate the vector.
// Note that this might trigger a heapcleaning, moving things around:
//
vec = allocate_nonempty_wordslots_vector__may_heapclean( task, BYTES_TO_WORDS(n), NULL );
memcpy( PTR_CAST(char*, vec), c_vec, n );
unbuffer_mythryl_heap_value( &vec_buf );
}
Val result = make_vector_header(task, STRING_TAGWORD, vec, n);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_FileSys_fchown (Task* task, Val arg) {
//======================
//
// Mythryl type: (Int, Unt, Unt) -> Void
// fd uid gid
//
// Change owner and group of file given a file descriptor for it.
//
// This fn gets bound as fchown' 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 fd = GET_TUPLE_SLOT_AS_INT( arg, 0);
uid_t uid = TUPLE_GETWORD( arg, 1);
gid_t gid = TUPLE_GETWORD( arg, 2);
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
int status = fchown (fd, uid, gid);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
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_TTY_tcgetattr (Task* task, Val arg) {
//=====================
//
// Mythryl type: Int -> (Unt, Unt, Unt, Unt, String, Unt, Unt)
//
// Get parameters associated with tty.
//
// NOTE: the calls to cfget[io] speed by making the code more OS-dependent
// and using the package of struct termios.
//
// This fn gets bound as tcgetattr in:
//
// src/lib/std/src/psx/posix-tty.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int fd = TAGGED_INT_TO_C_INT( arg );
struct termios data;
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL);
//
int status = tcgetattr( fd, &data );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
if (status < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
Val iflag = make_one_word_unt(task, data.c_iflag ); Roots roots1 = { &iflag, NULL };
Val oflag = make_one_word_unt(task, data.c_oflag ); Roots roots2 = { &oflag, &roots1 };
Val cflag = make_one_word_unt(task, data.c_cflag ); Roots roots3 = { &cflag, &roots2 };
Val lflag = make_one_word_unt(task, data.c_lflag ); Roots roots4 = { &lflag, &roots3 };
Val ispeed = make_one_word_unt(task, cfgetispeed (&data) ); Roots roots5 = { &ispeed, &roots4 };
Val ospeed = make_one_word_unt(task, cfgetospeed (&data) ); Roots roots6 = { &ospeed, &roots5 };
Val cc = allocate_nonempty_ascii_string__may_heapclean (task, NCCS, &roots6 );
memcpy(
GET_VECTOR_DATACHUNK_AS( void*, cc ),
data.c_cc,
NCCS
);
// Construct the result vector:
//
set_slot_in_nascent_heapchunk (task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 7));
set_slot_in_nascent_heapchunk (task, 1, iflag);
set_slot_in_nascent_heapchunk (task, 2, oflag);
set_slot_in_nascent_heapchunk (task, 3, cflag);
set_slot_in_nascent_heapchunk (task, 4, lflag);
set_slot_in_nascent_heapchunk (task, 5, cc);
set_slot_in_nascent_heapchunk (task, 6, ispeed);
set_slot_in_nascent_heapchunk (task, 7, ospeed);
Val result = commit_nascent_heapchunk (task, 7);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_IO_lseek (Task* task, Val arg) {
//================
//
// Mythryl type: (Int, Int, Int) -> Int
//
// Move read/write file pointer.
//
// This fn gets bound as lseek' in:
//
// src/lib/std/src/psx/posix-io.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int fd = GET_TUPLE_SLOT_AS_INT( arg, 0 );
off_t offset = GET_TUPLE_SLOT_AS_INT( arg, 1 );
int whence = GET_TUPLE_SLOT_AS_INT( arg, 2 );
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
off_t pos = lseek(fd, offset, whence);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
Val result = RETURN_STATUS_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, pos, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_ProcEnv_setpgid (Task* task, Val arg) {
//=======================
//
// Mythryl type: (Int, Int) -> Void
//
// Set user id
//
// This fn gets bound as set_process_group_id in:
//
// src/lib/std/src/psx/posix-id.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int pid = GET_TUPLE_SLOT_AS_INT( arg, 0 );
int pgid = GET_TUPLE_SLOT_AS_INT( arg, 1 );
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
int status = setpgid( pid, pgid );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
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_ProcEnv_times (Task* task, Val arg) {
//=====================
//
// Mythryl type: Void -> (Int, Int, Int, Int, Int)
//
// Return process and child process times, in clock ticks.
//
// This fn gets bound as times' in:
//
// src/lib/std/src/posix-1003.1b/posix-id.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_ProcEnv_times");
Val e;
Val u, s;
Val cu, cs;
struct tms ts;
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_ProcEnv_times", NULL );
//
clock_t t = times( &ts );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_ProcEnv_times" );
if (t == -1) return RAISE_SYSERR__MAY_HEAPCLEAN(task, -1, NULL);
e = make_one_word_int(task, t );
u = make_one_word_int(task, ts.tms_utime );
s = make_one_word_int(task, ts.tms_stime );
cu = make_one_word_int(task, ts.tms_cutime);
cs = make_one_word_int(task, ts.tms_cstime);
return make_five_slot_record(task, e, u, s, cu, cs );
}
Val _lib7_P_FileSys_ftruncate (Task* task, Val arg) {
//=========================
//
// Mythryl type: (Int, Int) -> Void
// fd length
//
// This fn gets bound as ftruncate' in:
//
// src/lib/std/src/psx/posix-file.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int fd = GET_TUPLE_SLOT_AS_INT(arg, 0);
off_t len = GET_TUPLE_SLOT_AS_INT(arg, 1);
int status;
do {
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = ftruncate (fd, len); // This call can return EINTR, so it is officially "slow".
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
//
} while (status < 0 && errno == EINTR); // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
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_umask (Task* task, Val arg) {
//=====================
//
// Mythryl type : Unt -> Unt
//
// Set and get file creation mask
// Assumes umask never fails.
//
// This fn gets bound as umask' 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__);
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
mode_t omask = umask(WORD_LIB7toC(arg));
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
Val result = make_one_word_unt(task, (Vunt) omask );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_Sock_getpeername (Task* task, Val arg) {
//======================
//
// Mythryl type: Socket -> (Address_Family, Address)
//
// This function gets bound as get_peer_name' in:
//
// src/lib/std/src/socket/socket-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
char addr[ MAX_SOCK_ADDR_BYTESIZE ];
socklen_t address_len = MAX_SOCK_ADDR_BYTESIZE;
int sockfd = TAGGED_INT_TO_C_INT( arg ); // Last use of 'arg'.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
int status = getpeername (sockfd, (struct sockaddr *)addr, &address_len);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
if (status < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
Val cdata = make_biwordslots_vector_sized_in_bytes__may_heapclean( task, addr, address_len, NULL );
Val result = make_vector_header(task, UNT8_RO_VECTOR_TAGWORD, cdata, address_len);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_IO_pipe (Task* task, Val arg) {
//===============
//
// Mythryl type: Void -> (Int, Int)
//
// Create a pipe and return its input and output descriptors.
//
// This fn gets bound as pipe' 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 status;
int fds[2];
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = pipe(fds);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
// printf("Created pipe %d -> %d -- pipe.c thread id %lx\n", fds[0], fds[1], pth__get_hostthread_id); fflush(stdout);
Val result;
if (status == -1) result = RAISE_SYSERR__MAY_HEAPCLEAN(task, -1, NULL);
else result = make_two_slot_record( task, TAGGED_INT_FROM_C_INT(fds[0]), TAGGED_INT_FROM_C_INT(fds[1]) );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return 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_Sock_bind (Task* task, Val arg) {
//===============
//
// Mythryl type: (Socket, Addr) -> Void
//
// This function gets bound as bind' in:
//
// src/lib/std/src/socket/socket-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_Sock_bind");
int socket = GET_TUPLE_SLOT_AS_INT( arg, 0 );
Val addr = GET_TUPLE_SLOT_AS_VAL( arg, 1 ); // Last use of 'arg'.
struct sockaddr* heap_sockaddr = GET_VECTOR_DATACHUNK_AS( struct sockaddr*, addr );
int addr_len = GET_VECTOR_LENGTH( addr ); // Last use of 'addr'.
struct sockaddr c_sockaddr = *heap_sockaddr; // May not reference Mythryl heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP, so make copy on C stack.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_bind", NULL );
//
int status = bind (socket, &c_sockaddr, addr_len);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_bind" );
RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
}
Val _lib7_P_IO_fcntl_sfd (Task* task, Val arg) {
//====================
//
// Mythryl type: (Int, Unt) -> Void
//
// Set the close-on-exec flag associated with the file descriptor.
//
// This fn gets bound as fcntl_sfd 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_fcntl_sfd");
int status;
int fd0 = GET_TUPLE_SLOT_AS_INT( arg, 0 );
Vunt flag = TUPLE_GETWORD( arg, 1 );
/* 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_fcntl_sfd", NULL );
//
status = fcntl(fd0, F_SETFD, flag);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_IO_fcntl_sfd" );
/* } while (status < 0 && errno == EINTR); */ // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
}
Val _lib7_P_FileSys_fchmod (Task* task, Val arg) {
//======================
//
// Mythryl type: (Fd, Unt) -> Void
// fd mode
//
// Change mode of file.
//
// This fn gets bound as fchmod' 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 fd = GET_TUPLE_SLOT_AS_INT( arg, 0);
mode_t mode = TUPLE_GETWORD( arg, 1);
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
int status = fchmod (fd, mode);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
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_fsync (Task* task, Val arg) {
//================
//
// Mythryl type: Sy_Int -> Void
//
// Synchronize a file's in-core state with storage
//
// This fn gets bound as fsync' 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_fsync");
int status;
int fd = TAGGED_INT_TO_C_INT(arg);
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_IO_fsync", NULL );
//
status = fsync(fd);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_IO_fsync" );
RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
}
Val _lib7_Sock_getATMARK (Task* task, Val arg) {
//====================
//
// Mythryl type: Socket_Fd -> Int
//
// This fn gets bound as get_atmark' in:
//
// src/lib/std/src/socket/socket-guts.pkg
//
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int device = TAGGED_INT_TO_C_INT( arg ); // Last use of 'arg'.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
int n;
int status = ioctl (device, SIOCATMARK, (char*) &n );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
if (status < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return n ? HEAP_TRUE : HEAP_FALSE;
}
Val _lib7_Time_timeofday (Task* task, Val arg) {
//====================
//
// Mythryl type: Void -> (one_word_int::Int, Int)
//
// Return the time of day.
// NOTE: gettimeofday() is not POSIX (time() returns seconds, and is POSIX and ISO C).
//
// This fn gets bound as get_time_of_day in:
//
// src/lib/std/src/time-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int c_microseconds;
Val lib7_seconds;
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
int c_seconds = _lib7_time_gettimeofday( &c_microseconds );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
lib7_seconds = make_one_word_int(task, c_seconds );
Val result = make_two_slot_record(task, lib7_seconds, TAGGED_INT_FROM_C_INT( c_microseconds ) );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_IO_readbuf (Task* task, Val arg) {
//==================
//
// Mythryl type: (Int, rw_vector_of_one_byte_unts::Rw_Vector, Int, Int) -> Int
// fd data nbytes start
//
// Read nbytes of data from the specified file
// into the given array starting at start.
// Return the number of bytes read.
// Assume bounds have been checked.
//
// This fn gets bound as readbuf' in:
//
// src/lib/std/src/posix-1003.1b/posix-io.pkg
// src/lib/std/src/posix-1003.1b/posix-io-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_IO_readbuf");
int fd = GET_TUPLE_SLOT_AS_INT( arg, 0 );
// Val buf = GET_TUPLE_SLOT_AS_VAL( arg, 1 ); // We'll do this after the read().
int nbytes = GET_TUPLE_SLOT_AS_INT( arg, 2 );
// int offset = GET_TUPLE_SLOT_AS_INT( arg, 3 ); // We'll do this after the read().
int n;
Mythryl_Heap_Value_Buffer vec_buf;
{ char* c_vec // Get a pointer to 'nbytes' of free ram outside the Mythryl heap
= // (i.e., ram guaranteed not to move around during a heapcleaning).
buffer_mythryl_heap_nonvalue( &vec_buf, nbytes );
/* do { */ // Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_IO_readbuf", &arg ); // 'arg' is still live here!
//
n = read( fd, c_vec, nbytes );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_IO_readbuf" );
/* } while (n < 0 && errno == EINTR); */ // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
// The heapcleaner may have moved everything around
// during our read() call, so we wait until now to
// track down the location of our buf vector:
//
Val buf = GET_TUPLE_SLOT_AS_VAL( arg, 1 );
char* start = HEAP_STRING_AS_C_STRING(buf) + GET_TUPLE_SLOT_AS_INT( arg, 3 );
// Copy the bytes read into given
// string 'buf' on Mythryl heap:
//
memcpy( start, c_vec, n ); // Caller is responsible for guaranteeing that this will not overrun the vector and clobber the Mythryl heap.
unbuffer_mythryl_heap_value( &vec_buf );
}
RETURN_STATUS_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, n, NULL);
}
Val 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_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_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_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_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_FileSys_symlink (Task* task, Val arg) {
//=======================
//
// Mythryl type: (String, String) -> Void
// existing newname
//
// Creates a symbolic link from newname to existing file.
//
// This fn gets bound as symlink' in:
//
// src/lib/std/src/psx/posix-file.pkg
// src/lib/std/src/psx/posix-file-system-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int status;
Val existing = GET_TUPLE_SLOT_AS_VAL( arg, 0 );
Val new_name = GET_TUPLE_SLOT_AS_VAL( arg, 1 );
char* heap_existing = HEAP_STRING_AS_C_STRING( existing );
char* heap_new_name = HEAP_STRING_AS_C_STRING( new_name );
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so copy heap_existing and
// heap_new_name into C storage:
//
Mythryl_Heap_Value_Buffer existing_buf;
Mythryl_Heap_Value_Buffer new_name_buf;
//
{ char* c_existing = buffer_mythryl_heap_value( &existing_buf, (void*) heap_existing, strlen( heap_existing ) +1 ); // '+1' for terminal NUL on string.
char* c_new_name = buffer_mythryl_heap_value( &new_name_buf, (void*) heap_new_name, strlen( heap_new_name ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = symlink( c_existing, c_new_name );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
unbuffer_mythryl_heap_value( &existing_buf );
unbuffer_mythryl_heap_value( &new_name_buf );
}
Val result = RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_FileSys_openf (Task* task, Val arg) {
//=====================
//
// Mythryl type: (String, Unt, Unt) -> int
// name flags mode
//
// Open a file and return the file descriptor.
//
// This fn gets bound as openf' in:
//
// src/lib/std/src/posix-1003.1b/posix-file.pkg
// src/lib/std/src/posix-1003.1b/posix-file-system-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_FileSys_openf");
Val path = GET_TUPLE_SLOT_AS_VAL( arg, 0);
int flags = TUPLE_GETWORD( arg, 1);
int mode = TUPLE_GETWORD( arg, 2);
int fd;
char* heap_path = HEAP_STRING_AS_C_STRING( path );
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so copy heap_path into C storage:
//
Mythryl_Heap_Value_Buffer path_buf;
//
{ char* c_path
=
buffer_mythryl_heap_value( &path_buf, (void*) heap_path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
/* do { */ // Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_openf", NULL );
//
fd = open( c_path, flags, mode );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_openf" );
/* } while (fd < 0 && errno == EINTR); */ // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
unbuffer_mythryl_heap_value( &path_buf );
}
RETURN_STATUS_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN( task, fd, NULL );
}
Val _lib7_netdb_get_protocol_by_name (Task* task, Val arg) {
//================================
//
// Mythryl type: String -> Null_Or( (String, List(String), Int) )
//
// This fn gets bound as get_prot_by_name' in:
//
// src/lib/std/src/socket/net-protocol-db.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
struct protoent* pentry;
char* heap_name = HEAP_STRING_AS_C_STRING( arg ); // Last use of 'arg'.
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so copy heap_name into C storage:
//
Mythryl_Heap_Value_Buffer name_buf;
//
{ char* c_name = buffer_mythryl_heap_value( &name_buf, (void*) heap_name, strlen( heap_name ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
pentry = getprotobyname( c_name );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
unbuffer_mythryl_heap_value( &name_buf );
}
if (pentry == NULL) return OPTION_NULL;
Val name = make_ascii_string_from_c_string__may_heapclean (task, pentry->p_name, NULL ); Roots roots1 = { &name, NULL };
Val aliases = make_ascii_strings_from_vector_of_c_strings__may_heapclean (task, pentry->p_aliases, &roots1 );
Val result
=
make_three_slot_record( task, name, aliases, TAGGED_INT_FROM_C_INT(pentry->p_proto) );
result = OPTION_THE( task, result );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_FileSys_chown (Task* task, Val arg) {
//=====================
//
// Mythryl type: (String, Unt, Unt) -> Void
// name uid gid
//
// Change owner and group of file given its name.
//
// This fn gets bound as chown' in:
//
// src/lib/std/src/psx/posix-file.pkg
// src/lib/std/src/psx/posix-file-system-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int status;
Val path = GET_TUPLE_SLOT_AS_VAL( arg, 0);
uid_t uid = TUPLE_GETWORD( arg, 1);
gid_t gid = TUPLE_GETWORD( arg, 2);
char* heap_path= HEAP_STRING_AS_C_STRING(path);
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so copy heap_path into C storage:
//
Mythryl_Heap_Value_Buffer path_buf;
//
{ char* c_path
=
buffer_mythryl_heap_value( &path_buf, (void*) path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = chown (c_path, uid, gid);
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
//
unbuffer_mythryl_heap_value( &path_buf );
}
Val result = RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_P_SysDB_getpwnam (Task* task, Val arg) {
//======================
//
// _lib7_P_SysDB_getpwnam : String -> (String, word, word, String, String)
//
// Get password file entry by name.
//
// This fn gets bound as getpwnam' in:
//
// src/lib/std/src/posix-1003.1b/posix-etc.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_SysDB_getpwnam");
struct passwd* info;
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so copy heap_path into C storage:
//
Mythryl_Heap_Value_Buffer name_buf;
//
{ char* heap_name = HEAP_STRING_AS_C_STRING( arg );
char* c_name
=
buffer_mythryl_heap_value( &name_buf, (void*) heap_name, strlen( heap_name ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_SysDB_getpwnam", NULL );
//
info = getpwnam( c_name );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_SysDB_getpwnam" );
unbuffer_mythryl_heap_value( &name_buf );
}
if (info == NULL) return RAISE_SYSERR__MAY_HEAPCLEAN(task, -1, NULL);
Val pw_name = make_ascii_string_from_c_string__may_heapclean( task, info->pw_name, NULL ); Roots roots1 = { &pw_name, NULL };
Val pw_uid = make_one_word_unt( task, (Vunt) (info->pw_uid) ); Roots roots2 = { &pw_uid, &roots1 };
Val pw_gid = make_one_word_unt( task, (Vunt) (info->pw_gid) ); Roots roots3 = { &pw_gid, &roots2 };
Val pw_dir = make_ascii_string_from_c_string__may_heapclean( task, info->pw_dir, &roots3 ); Roots roots4 = { &pw_dir, &roots3 };
Val pw_shell = make_ascii_string_from_c_string__may_heapclean( task, info->pw_shell, &roots4 );
return make_five_slot_record(task, pw_name, pw_uid, pw_gid, pw_dir, pw_shell );
}
Val _lib7_P_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;
}
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 );
}
