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_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_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_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_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_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_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;
}
/* _lib7_win32_PS_get_environment_variable : String -> String option
* var
*
*/
Val _lib7_win32_PS_get_environment_variable(Task *task, Val arg)
{
#define GEV_BUF_SZ 4096
char buf[GEV_BUF_SZ];
int ret = GetEnvironmentVariable(HEAP_STRING_AS_C_STRING(arg),buf,GEV_BUF_SZ);
Val ml_s;
if (ret > GEV_BUF_SZ) {
return RAISE_SYSERR__MAY_HEAPCLEAN(task,-1,NULL);
}
if (ret > 0) {
ml_s = make_ascii_string_from_c_string__may_heapclean(task,buf,NULL);
return OPTION_THE( task, ml_s );
}
return OPTION_NULL;
#undef GEV_BUF_SZ
}
Val 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_netdb_get_host_name (Task* task, Val arg) {
//=========================
//
// Mythryl type: Void -> String
//
// This fn gets bound as get_host_name in:
//
// src/lib/std/src/socket/dns-host-lookup.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_netdb_get_host_name");
char hostname[ MAXHOSTNAMELEN ];
RELEASE_MYTHRYL_HEAP( task->pthread, "", NULL );
//
if (gethostname( hostname, MAXHOSTNAMELEN ) == -1) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "" );
return make_ascii_string_from_c_string__may_heapclean( task, hostname, NULL );
}
Val _lib7_Sock_shutdown (Task* task, Val arg) {
//===================
//
// Mythryl type: (Socket, Int) -> Void
//
// This fn gets bound to shutdown' in:
//
// src/lib/std/src/socket/socket-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_Sock_shutdown");
// RAISE_SYSERR__MAY_HEAPCLEAN def in src/c/lib/raise-error.h
int socket = GET_TUPLE_SLOT_AS_INT( arg, 0 );
int how = GET_TUPLE_SLOT_AS_INT( arg, 1 ); // Last use of 'arg'.
// shutdown is documented by man 2 shutdown
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_shutdown", NULL );
//
if (shutdown( socket, how ) < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL); // Where is 'status' coming from? Is this rational?
// // ('status' is ignored except on MacOS, where this is probably broken) XXX BUGGO FIXME
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_shutdown" );
return HEAP_VOID;
}
Val _lib7_Sock_accept (Task* task, Val arg) {
//=================
//
// Mythryl type: Socket -> (Socket, Address)
//
// This fn gets bound as accept' in:
//
// src/lib/std/src/socket/socket-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_Sock_accept");
int socket = TAGGED_INT_TO_C_INT( arg ); // Last use of 'arg'.
char address_buf[ MAX_SOCK_ADDR_BYTESIZE ];
socklen_t address_len = MAX_SOCK_ADDR_BYTESIZE;
int new_socket;
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_accept", NULL );
//
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c */
new_socket = accept (socket, (struct sockaddr*) address_buf, &address_len);
/* } while (new_socket < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_accept" );
if (new_socket == -1) {
//
return RAISE_SYSERR__MAY_HEAPCLEAN( task, new_socket, NULL);
//
} else {
//
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);
return make_two_slot_record(task, TAGGED_INT_FROM_C_INT( new_socket ), address);
}
}
Val _lib7_Date_greanwich_mean_time (Task* task, Val arg) {
//==============================
//
// Mythryl type: one_word_int::Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int)
//
// Takes a UTC time value (in seconds), and converts it to a 9-tuple with
// the fields: tm_sec, tm_min, tm_hour, tm_mday, tm_mon, tm_year, tm_wday,
// tm_yday, and tm_isdst.
//
// This fn gets bound to gm_time' in:
//
// src/lib/std/src/date.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_Date_greanwich_mean_time");
time_t t = (time_t) INT1_LIB7toC(arg);
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_Date_greanwich_mean_time", NULL );
//
struct tm* tm = gmtime( &t );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_Date_greanwich_mean_time" );
if (tm == NULL) return RAISE_SYSERR__MAY_HEAPCLEAN(task,0,NULL);
set_slot_in_nascent_heapchunk(task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 9));
set_slot_in_nascent_heapchunk(task, 1, TAGGED_INT_FROM_C_INT(tm->tm_sec));
set_slot_in_nascent_heapchunk(task, 2, TAGGED_INT_FROM_C_INT(tm->tm_min));
set_slot_in_nascent_heapchunk(task, 3, TAGGED_INT_FROM_C_INT(tm->tm_hour));
set_slot_in_nascent_heapchunk(task, 4, TAGGED_INT_FROM_C_INT(tm->tm_mday));
set_slot_in_nascent_heapchunk(task, 5, TAGGED_INT_FROM_C_INT(tm->tm_mon));
set_slot_in_nascent_heapchunk(task, 6, TAGGED_INT_FROM_C_INT(tm->tm_year));
set_slot_in_nascent_heapchunk(task, 7, TAGGED_INT_FROM_C_INT(tm->tm_wday));
set_slot_in_nascent_heapchunk(task, 8, TAGGED_INT_FROM_C_INT(tm->tm_yday));
set_slot_in_nascent_heapchunk(task, 9, TAGGED_INT_FROM_C_INT(tm->tm_isdst));
return commit_nascent_heapchunk(task, 9);
}
Val _lib7_Sock_getNREAD (Task* task, Val arg) {
//===================
//
// Mythryl type: Socket -> Int
//
// This fn gets bound as get_nread' in:
//
// src/lib/std/src/socket/socket-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_Sock_getNREAD");
int device = TAGGED_INT_TO_C_INT( arg ); // Last use of 'arg'.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_getNREAD", NULL );
//
int n;
int status = ioctl( device, FIONREAD, (char*) &n );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_getNREAD" );
if (status < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
return TAGGED_INT_FROM_C_INT( n );
}
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_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 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_P_FileSys_readlink (Task* task, Val arg) {
//========================
//
// Mythryl type: String -> String
//
// Read the value of a symbolic link.
//
// The following implementation assumes that the system readlink
// fills the given buffer as much as possible, without nul-termination,
// and returns the number of bytes copied. If the buffer is not large
// enough, the return value will be at least the buffer size. In that
// case, we find out how big the link really is, allocate a buffer to
// hold it, and redo the readlink.
//
// Note that the above semantics are not those of POSIX, which requires
// null-termination on success, and only fills the buffer up to at most
// the penultimate byte even on failure.
//
// Should this be written to avoid the extra copy, using heap memory?
//
// This fn gets bound as readlink in:
//
// src/lib/std/src/posix-1003.1b/posix-file.pkg
// src/lib/std/src/posix-1003.1b/posix-file-system-64.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_FileSys_readlink");
struct stat sbuf;
int len;
int result;
char* heap_path = HEAP_STRING_AS_C_STRING( arg );
char buf[MAXPATHLEN];
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so copy heap_path into C storage:
//
Mythryl_Heap_Value_Buffer path_buf;
//
{ char* c_path
=
buffer_mythryl_heap_value( &path_buf, (void*) heap_path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink", NULL );
//
len = readlink(c_path, buf, MAXPATHLEN);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink" );
unbuffer_mythryl_heap_value( &path_buf );
}
if (len < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, len, NULL);
if (len < MAXPATHLEN) {
//
buf[len] = '\0';
return make_ascii_string_from_c_string__may_heapclean (task, buf, NULL);
}
// Buffer not big enough.
// Determine how big the link text is and allocate a buffer.
{ char* c_path
=
buffer_mythryl_heap_value( &path_buf, (void*) heap_path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink", NULL );
//
result = lstat (c_path, &sbuf);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink" );
unbuffer_mythryl_heap_value( &path_buf );
}
if (result < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, result, NULL);
int nlen = sbuf.st_size + 1;
char* nbuf = MALLOC(nlen);
if (nbuf == 0) return RAISE_ERROR__MAY_HEAPCLEAN(task, "out of malloc memory", NULL);
// Try the readlink again. Give up on error or if len is still bigger
// than the buffer size.
//
{ char* c_path
=
buffer_mythryl_heap_value( &path_buf, (void*) heap_path, strlen( heap_path ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink", NULL );
//
len = readlink(c_path, buf, len);
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_FileSys_readlink" );
unbuffer_mythryl_heap_value( &path_buf );
}
if (len < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, len, NULL);
if (len >= nlen) return RAISE_ERROR__MAY_HEAPCLEAN(task, "readlink failure", NULL);
nbuf[len] = '\0';
Val chunk = make_ascii_string_from_c_string__may_heapclean (task, nbuf, NULL);
FREE (nbuf);
//
return chunk;
}
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;
}