Val _lib7_P_IO_dup2 (Task* task, Val arg) {
//===============
//
// Mythryl type: (Int, Int) -> Void
//
// Duplicate an open file descriptor
//
// This fn gets bound as dup2' in:
//
// src/lib/std/src/posix-1003.1b/posix-io.pkg
// src/lib/std/src/posix-1003.1b/posix-io-64.pkg
int fd0 = GET_TUPLE_SLOT_AS_INT( arg, 0 );
int fd1 = GET_TUPLE_SLOT_AS_INT( arg, 1 );
int status;
/* do { */ // Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c
status = dup2(fd0, fd1);
/* } while (status < 0 && errno == EINTR); */ // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
CHECK_RETURN_UNIT(task,status)
}
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_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_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_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_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);
}
/* do__set_window_position
*
* opengl-client.api type: { session: Session, x: Int, y: Int } -> Void
* opengl-client-driver.api type: (Session, Int, Int) -> Void
*/
static Val do__set_window_position (Task* task, Val arg)
{
int i0 = GET_TUPLE_SLOT_AS_INT( arg, 1);
int i1 = GET_TUPLE_SLOT_AS_INT( arg, 2);
glfwSetWindowPos( /*x*/i0, /*y*/i1 );
return HEAP_VOID;
}
/* do__open_window
*
* opengl-client.api type: { session: Session, wide: Int, high: Int } -> Bool
* opengl-client-driver.api type: (Session, Int, Int) -> Bool
*/
static Val do__open_window (Task* task, Val arg)
{
int i0 = GET_TUPLE_SLOT_AS_INT( arg, 1);
int i1 = GET_TUPLE_SLOT_AS_INT( arg, 2);
int result = glfwOpenWindow( /*wide*/i0, /*high*/i1, /*redbits*/0, /*greenbits*/0, /*bluebits*/0, /*alphabits*/0, /*depthbits*/0, /*stencilbits*/0, /*fullscreen*/GLFW_WINDOW );
return result ? HEAP_TRUE : HEAP_FALSE;
}
/* do__set_window_size
*
* opengl-client.api type: { session: Session, wide: Int, high: Int } -> Void
* opengl-client-driver.api type: (Session, Int, Int) -> Void
*/
static Val do__set_window_size (Task* task, Val arg)
{
int i0 = GET_TUPLE_SLOT_AS_INT( arg, 1);
int i1 = GET_TUPLE_SLOT_AS_INT( arg, 2);
glfwSetWindowSize( /*wide*/i0, /*high*/i1 );
return HEAP_VOID;
}
/* do__move
*
* ncurses-client.api type: { session: Session, x: Int, y: Int } -> Void
* ncurses-client-driver.api type: (Session, Int, Int) -> Void
*/
static Val do__move (Task* task, Val arg)
{
int i0 = GET_TUPLE_SLOT_AS_INT( arg, 1);
int i1 = GET_TUPLE_SLOT_AS_INT( arg, 2);
move( /*y*/i0, /*x*/i1 );
return HEAP_VOID;
}
Val _lib7_Date_ascii_time (Task* task, Val arg) {
//==================
//
// Mythryl type: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> String
//
// This takes a nine-tuple date (fields sec, min, hour, mday, mon, year, wday,
// yday, and isdst), and converts it into a string representation.
//
// This fn gets bound to 'ascii_time' in:
//
// src/lib/std/src/date.pkg
struct tm tm;
//
tm.tm_sec = GET_TUPLE_SLOT_AS_INT(arg, 0);
tm.tm_min = GET_TUPLE_SLOT_AS_INT(arg, 1);
tm.tm_hour = GET_TUPLE_SLOT_AS_INT(arg, 2);
tm.tm_mday = GET_TUPLE_SLOT_AS_INT(arg, 3);
tm.tm_mon = GET_TUPLE_SLOT_AS_INT(arg, 4);
tm.tm_year = GET_TUPLE_SLOT_AS_INT(arg, 5);
tm.tm_wday = GET_TUPLE_SLOT_AS_INT(arg, 6);
tm.tm_yday = GET_TUPLE_SLOT_AS_INT(arg, 7);
tm.tm_isdst = GET_TUPLE_SLOT_AS_INT(arg, 8);
Val result = allocate_nonempty_ascii_string(task, DATE_LEN);
strncpy (HEAP_STRING_AS_C_STRING(result), asctime(&tm), DATE_LEN);
return result;
}
Val _lib7_P_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_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_TTY_tcflow (Task* task, Val arg) {
//==================
//
// Mythrryl type: (Int, Int) -> Void
//
// Suspend transmission or receipt of data.
//
// This fn gets bound as tcflow in:
//
// src/lib/std/src/posix-1003.1b/posix-tty.pkg
int status = tcflow( GET_TUPLE_SLOT_AS_INT(arg, 0),GET_TUPLE_SLOT_AS_INT(arg, 1) );
CHECK_RETURN_UNIT(task, status)
}
Val _lib7_P_TTY_tcflush (Task* task, Val arg) {
//====================
//
// Mythryl type: (Int, Int) -> Void
//
// Discard data that is written but not sent, or received but not read.
//
// This fn gets bound as tcflush in:
//
// src/lib/std/src/posix-1003.1b/posix-tty.pkg
int status = tcflush(GET_TUPLE_SLOT_AS_INT(arg, 0),GET_TUPLE_SLOT_AS_INT(arg, 1));
//
CHECK_RETURN_UNIT(task, status)
}
Val _lib7_Ncurses_move (Task* task, Val arg) { // : (Int, Int) -> Void
//==================
//
#if HAVE_CURSES_H && HAVE_LIBNCURSES
int y = INT1_LIB7toC( GET_TUPLE_SLOT_AS_INT(arg, 0) );
int x = INT1_LIB7toC( GET_TUPLE_SLOT_AS_INT(arg, 1) );
int result = move( y, x );
if (result == ERR) return RAISE_ERROR(task, "move");
return HEAP_VOID;
#else
extern char* no_ncurses_support_in_runtime;
return RAISE_ERROR(task, no_ncurses_support_in_runtime);
#endif
}
Val _lib7_runtime_make_codechunk_executable (Task* task, Val arg) {
//=======================================
//
// Mythryl type: (rw_vector_of_one_byte_unts::Rw_Vector, Int) -> (Chunk -> Chunk) // The Int is the entrypoint offset within the bytevector of executable machine code -- currently always zero in practice.
//
// Turn a previously constructed machine-code bytvector into a closure.
// This requires that we flush the I-cache. (This is a no-op on intel32.)
//
// This fn gets bound as make_executable in:
//
// src/lib/compiler/execution/code-segments/code-segment.pkg
Val seq = GET_TUPLE_SLOT_AS_VAL( arg, 0 );
int entrypoint = GET_TUPLE_SLOT_AS_INT( arg, 1 ); // In practice entrypoint is currently always zero.
char* code = GET_VECTOR_DATACHUNK_AS( char*, seq );
Val_Sized_Unt nbytes /* This variable is unused on some platforms, so suppress 'unused var' compiler warning: */ __attribute__((unused))
=
GET_VECTOR_LENGTH( seq );
flush_instruction_cache( code, nbytes ); // flush_instruction_cache is a no-op on intel32
// flush_instruction_cache def in src/c/h/flush-instruction-cache-system-dependent.h
Val result;
REC_ALLOC1(task, result, PTR_CAST( Val, code + entrypoint));
return result;
}
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_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);
}
/* _lib7_win32_IO_read_vec : (one_word_unt * int) -> word8vector.Vector
* handle nbytes
*
* Read the specified number of bytes from the specified handle,
* returning them in a vector.
*
* Note: Read operations on console devices do not trap ctrl-C.
* ctrl-Cs are placed in the input buffer.
*/
Val _lib7_win32_IO_read_vec(Task *task, Val arg)
{
HANDLE h = (HANDLE) WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg, 0));
DWORD nbytes = (DWORD) GET_TUPLE_SLOT_AS_INT(arg, 1);
DWORD n;
// Allocate the vector.
// Note that this might cause a GC:
//
Val vec = allocate_nonempty_int1_vector( task, BYTES_TO_WORDS (nbytes) );
if (ReadFile( h, PTR_CAST(void*, vec), nbytes, &n, NULL)) {
if (n == 0) {
#ifdef WIN32_DEBUG
debug_say("_lib7_win32_IO_read_vec: eof on device\n");
#endif
return ZERO_LENGTH_STRING__GLOBAL;
}
if (n < nbytes) {
//
shrink_fresh_int1_vector( task, vec, BYTES_TO_WORDS(n) );
}
/* Allocate header: */
{ Val result;
SEQHDR_ALLOC (task, result, STRING_TAGWORD, vec, n);
return result;
}
} else {
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_FileSys_ftruncate_64 (Task* task, Val arg) {
//============================
//
// Mythryl type: (Int, Unt1, Unt1) -> Void
// fd lengthhi lengthlo
//
// Make a directory.
//
// This fn gets bound as ftruncate' in:
//
// src/lib/std/src/posix-1003.1b/posix-file-system-64.pkg
int fd = GET_TUPLE_SLOT_AS_INT(arg, 0);
//
off_t len =
(sizeof(off_t) > 4)
? (((off_t)WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg, 1))) << 32) |
((off_t)(WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg, 2))))
: ((off_t)(WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg, 2))));
int status;
/* do { */ // Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c
status = ftruncate (fd, len);
/* } while (status < 0 && errno == EINTR); */ // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
CHECK_RETURN_UNIT(task, status)
}
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;
}
/* do__negate_int
*
* opengl-client.api type: (Session, Int) -> Int
* opengl-client-driver.api type: (Session, Int) -> Int
*/
static Val do__negate_int (Task* task, Val arg)
{
int i0 = GET_TUPLE_SLOT_AS_INT( arg, 1);
int result = -i0;
return TAGGED_INT_FROM_C_INT(result);
}
/* do__addch
*
* ncurses-client.api type: (Session, Int) -> Void
* ncurses-client-driver.api type: (Session, Int) -> Void
*/
static Val do__addch (Task* task, Val arg)
{
int i0 = GET_TUPLE_SLOT_AS_INT( arg, 1);
addch(i0);
return HEAP_VOID;
}
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_listen (Task* task, Val arg) {
//=================
//
// Mythryl type: (Socket, Int) -> Void
//
// This fn gets bound as listen' in:
//
// src/lib/std/src/socket/socket-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_Sock_listen");
int socket = GET_TUPLE_SLOT_AS_INT( arg, 0 );
int backlog = GET_TUPLE_SLOT_AS_INT( arg, 1 ); // Last use of 'arg'.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_listen", NULL );
//
int status = listen( socket, backlog );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_Sock_listen" );
RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN( task, status, NULL );
}
Val _lib7_P_Process_waitpid (Task* task, Val arg) {
//=======================
//
// Mythryl type: (Int, Unt) -> (Int, Int, Int)
//
// Wait for child processes to stop or terminate.
//
// This fn gets bound as waitpid' in:
//
// src/lib/std/src/posix-1003.1b/posix-process.pkg
int status;
int how;
int val;
int pid;
/* do { */ // Backed out 2010-02-26 CrT: See discussion at bottom of src/c/lib/socket/connect.c
pid = waitpid(GET_TUPLE_SLOT_AS_INT(arg, 0), &status, TUPLE_GETWORD(arg, 1));
/* } while (pid < 0 && errno == EINTR); */ // Restart if interrupted by a SIGALRM or SIGCHLD or whatever.
if (pid < 0) return RAISE_SYSERR(task, pid);
if (WIFEXITED(status)) {
//
how = 0;
val = WEXITSTATUS(status);
} else if (WIFSIGNALED(status)) {
how = 1;
val = WTERMSIG(status);
} else if (WIFSTOPPED(status)) {
how = 2;
val = WSTOPSIG(status);
} else {
return RAISE_ERROR(task, "unknown child status");
}
Val result;
REC_ALLOC3(task, result, TAGGED_INT_FROM_C_INT(pid), TAGGED_INT_FROM_C_INT(how), TAGGED_INT_FROM_C_INT(val));
return result;
}
Val _lib7_P_TTY_tcsendbreak (Task* task, Val arg) {
//=======================
//
// Mythryl type: (Int, Int) -> Void
//
// Send break condition on tty line.
//
// This fn gets bound as tcsendbreak in:
//
// src/lib/std/src/posix-1003.1b/posix-tty.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_TTY_tcsendbreak");
int fd = GET_TUPLE_SLOT_AS_INT( arg, 0 );
int duration = GET_TUPLE_SLOT_AS_INT( arg, 1 );
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_TTY_tcsendbreak", NULL );
//
int status = tcsendbreak( fd, duration );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_TTY_tcsendbreak" );
RETURN_VOID_EXCEPT_RAISE_SYSERR_ON_NEGATIVE_STATUS__MAY_HEAPCLEAN(task, status, NULL);
}
/* 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;
}
