Val make_mythryl_signal_handler_arg ( // Called only from handle-interprocess-signal code in src/c/main/run-mythryl-code-and-runtime-eventloop.c
//===============================
//
Task* task,
Val* resume_after_handling_signal
){
// We're handling an interprocess signal for
//
// src/c/main/run-mythryl-code-and-runtime-eventloop.c
//
// Depending on platform, resume_after_handling_signal
// is from one of
// src/c/machine-dependent/prim.intel32.asm
// src/c/machine-dependent/prim.intel32.masm
// src/c/machine-dependent/prim.sun.asm
// src/c/machine-dependent/prim.pwrpc32.asm
//
// Our job is to build the Mythryl argument record for
// the Mythryl signal handler. The handler has type
//
// posix_interprocess_signal_handler : (Int, Int, Fate(Void)) -> X
//
// where
// The first argument is the signal id // For example SIGALRM,
// the second argument is the signal count // I.e., number of times signal has been recieved since last handled.
// the third argument is the resumption fate.
//
// The return type is X because the Mythryl
// signal handler should never return.
//
// NOTE: Maybe this should be combined with choose_signal??? XXX BUGGO FIXME
Hostthread* hostthread = task->hostthread;
Val run_fate = make_posthandler_resumption_fate_from_task( task, resume_after_handling_signal );
// Allocate the Mythryl signal handler's argument record:
//
Val arg = make_three_slot_record( task,
//
TAGGED_INT_FROM_C_INT( hostthread->next_posix_signal_id ),
TAGGED_INT_FROM_C_INT( hostthread->next_posix_signal_count ),
run_fate
);
if (hostthread->next_posix_signal_id == 2 /*SIGINT*/) ramlog_printf("#%d make_mythryl_signal_handler_arg: hostthread->next_posix_signal_id==SIGINT\n", syscalls_seen );
#ifdef SIGNAL_DEBUG
debug_say( "make_mythryl_signal_handler_arg: resumeC = %#x, arg = %#x\n", run_fate, arg );
#endif
return arg;
}
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_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;
}
// opengl-client.api type: (None -- not exported to opengl-client.api level.)
// opengl-client-driver.api type: Void -> Int
//
static Val do__number_of_queued_callbacks (Task* task, Val arg) {
// ==============================
//
int result = number_of_queued_callbacks ();
//
return TAGGED_INT_FROM_C_INT( result );
}
Val _util_NetDB_mkservent (Task* task, struct servent* sentry) {
//=====================
//
// Mythryl type:
//
// Allocate an Lib7 value of type:
// Null_Or( (String, List(String), Int, String) )
// to represent a struct servent value. Note that the port number is returned
// in network byteorder, so we need to map it to host order.
if (sentry == NULL) return OPTION_NULL;
// If our agegroup0 buffer is more than half full,
// empty it by doing a heapcleaning. This is very
// conservative -- which is the way I like it. :-)
//
if (agegroup0_freespace_in_bytes( task )
< agegroup0_usedspace_in_bytes( task )
){
call_heapcleaner( task, 0 );
}
// Build the return result:
Val name = make_ascii_string_from_c_string__may_heapclean( task, sentry->s_name, NULL ); Roots roots1 = { &name, NULL };
Val aliases = make_ascii_strings_from_vector_of_c_strings__may_heapclean( task, sentry->s_aliases, &roots1); Roots roots2 = { &aliases, &roots1 };
Val proto = make_ascii_string_from_c_string__may_heapclean( task, sentry->s_proto, &roots2); // Roots roots3 = { &proto, &roots2 };
Val port = TAGGED_INT_FROM_C_INT( ntohs(sentry->s_port) );
Val result = make_four_slot_record(task, name, aliases, port, proto);
return OPTION_THE( task, 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_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_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__getch
*
* ncurses-client.api type: Session -> Int
* ncurses-client-driver.api type: (Session) -> Int
*/
static Val do__getch (Task* task, Val arg)
{
int result = getch();
return TAGGED_INT_FROM_C_INT(result);
}
// opengl-client.api type: (None -- not exported to opengl-client.api level.)
// opengl-client-driver.api type: Void -> (Int, Int)
// callback x y
//
static Val do__get_queued_int_pair_callback (Task *task, Val arg) {
// ================================
Callback_Queue_Entry e = get_next_queued_callback ();
printf("do__get_queued_int_pair_callback called\n");
if (e.callback_type != QUEUED_INT_PAIR_CALLBACK) {
strcpy( text_buf, "get_queued_int_pair_callback: Next callback not Int_Pair." );
moan_and_die();
}
printf("do__get_queued_int_pair_callback called returning a record.\n");
set_slot_in_nascent_heapchunk( task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 3) );
set_slot_in_nascent_heapchunk( task, 1, TAGGED_INT_FROM_C_INT( e.callback_number ));
set_slot_in_nascent_heapchunk( task, 2, TAGGED_INT_FROM_C_INT( e.entry.int_pair.x ));
set_slot_in_nascent_heapchunk( task, 3, TAGGED_INT_FROM_C_INT( e.entry.int_pair.y ));
//
return commit_nascent_heapchunk(task, 3);
}
/* 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__set_window_size_event_callback : Session -> Window_Size_Event_Callback -> Void
*/
static Val do__set_window_size_event_callback (Task* task, Val arg)
{
int id = find_free_callback_id ();
window_size_event_callback_number = id;
glfwSetWindowSizeCallback( run_window_size_event_callback );
return TAGGED_INT_FROM_C_INT(id);
}
Val _lib7_P_ProcEnv_getpid (Task* task, Val arg) {
//======================
//
// Mythryl type: Void -> Int
//
// Return the process id of the current process.
//
// This fn gets bound as get_process_id in:
//
// src/lib/std/src/posix-1003.1b/posix-id.pkg
return TAGGED_INT_FROM_C_INT( getpid() );
}
// opengl-client.api type: (None -- not exported to opengl-client.api level.)
// opengl-client-driver.api type: Void -> Int
//
Val _lib7_Opengl_get_queued_void_callback (Task* task, Val arg) {
//==================================
//
Callback_Queue_Entry e = get_next_queued_callback ();
if (e.callback_type != QUEUED_VOID_CALLBACK) {
//
strcpy( text_buf, "get_queued_void_callback: Next callback not Void." );
moan_and_die();
}
//
return TAGGED_INT_FROM_C_INT( e.callback_number );
}
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_Process_osval (Task* task, Val arg) {
//=====================
//
// Mythryl type: String -> Int
//
// Return the OS-dependent, compile-time constant specified by the string.
//
// This fn gets bound as osval in:
//
// src/lib/std/src/posix-1003.1b/posix-process.pkg
name_val_t* result = _lib7_posix_nv_lookup (HEAP_STRING_AS_C_STRING(arg), values, NUMELMS);
//
if (result) return TAGGED_INT_FROM_C_INT(result->val);
else return RAISE_ERROR(task, "system constant not defined");
}
// opengl-client.api type: (None -- not exported to opengl-client.api level.)
// opengl-client-driver.api type: Void -> (Int, Bool)
//
Val _lib7_Opengl_get_queued_bool_callback (Task *task, Val arg) {
//==================================
//
Callback_Queue_Entry e = get_next_queued_callback ();
//
if (e.callback_type != QUEUED_BOOL_CALLBACK) {
strcpy( text_buf, "get_queued_bool_callback: Next callback not Bool." );
moan_and_die();
}
set_slot_in_nascent_heapchunk( task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 2));
set_slot_in_nascent_heapchunk( task, 1, TAGGED_INT_FROM_C_INT( e.callback_number ));
set_slot_in_nascent_heapchunk( task, 2, e.entry.bool_value ? HEAP_TRUE : HEAP_FALSE );
//
return commit_nascent_heapchunk(task, 2);
}
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);
}
// opengl-client.api type: (None -- not exported to opengl-client.api level.)
// opengl-client-driver.api type: Void -> (Int, Float)
//
Val _lib7_Opengl_get_queued_float_callback (Task* task, Val arg) {
//===================================
//
Callback_Queue_Entry e = get_next_queued_callback ();
//
if (e.callback_type != QUEUED_FLOAT_CALLBACK) {
strcpy( text_buf, "get_queued_float_callback: Next callback not Float." );
moan_and_die();
}
double d = e.entry.float_value;
Val boxed_double = make_float64(task, d ); // make_float64 is from src/c/h/make-strings-and-vectors-etc.h
set_slot_in_nascent_heapchunk( task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 2));
set_slot_in_nascent_heapchunk( task, 1, TAGGED_INT_FROM_C_INT( e.callback_number ));
set_slot_in_nascent_heapchunk( task, 2, boxed_double );
return commit_nascent_heapchunk(task, 2);
}
static Val get_sigvtalrm_interval_in_microseconds (Task* task, Val arg) {
// ======================================
//
// Mythryl type: Void -> int
//
// Return the profile timer quantim in microseconds.
//
// This fn gets bound as get_sigvtalrm_interval_in_microseconds in:
//
// src/lib/std/src/nj/runtime-profiling-control.pkg
//
// This fn is currently only called in:
//
// src/lib/compiler/debugging-and-profiling/profiling/write-time-profiling-report.pkg
//
ENTER_MYTHRYL_CALLABLE_C_FN("get_sigvtalrm_interval_in_microseconds");
return TAGGED_INT_FROM_C_INT( MICROSECONDS_PER_SIGVTALRM ); // From src/c/h/profiler-call-counts.h
}
Val _lib7_P_ProcEnv_getpgrp (Task* task, Val arg) {
//=======================
//
// Mythryl type: Void -> Int
//
// Return process group.
//
// This fn gets bound as get_process_group in:
//
// src/lib/std/src/posix-1003.1b/posix-id.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_ProcEnv_getpgrp");
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_ProcEnv_getpgrp", NULL );
//
int pgrp = getpgrp();
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_ProcEnv_getpgrp" );
return TAGGED_INT_FROM_C_INT( pgrp );
}
Val _lib7_NetDB_getrpcbynum (Task* task, Val arg) {
//=======================
//
// Mythryl type: Int -> Null_Or( (String, List(String), Int) )
//
// This fn is NOWHERE INVOKED. Nor listed in src/c/lib/socket/cfun-list.h Presumably should be either called or deleted: XXX BUGGO FIXME.
struct rpcent* rentry
=
getrpcbynumber( TAGGED_INT_TO_C_INT( arg ));
if (rentry == NULL) return OPTION_NULL;
Val name = make_ascii_string_from_c_string( task, rentry->r_name );
Val aliases = make_ascii_strings_from_vector_of_c_strings( task, rentry->r_aliases);
Val result;
REC_ALLOC3( task, result, name, aliases, TAGGED_INT_FROM_C_INT(rentry->r_number));
OPTION_THE( task, result, result);
return result;
}
Val _lib7_Sig_ascii_signal_name_to_portable_signal_id (Task* task, Val arg) {
//=================================================
//
// Mythryl type: String -> Int
//
// This fn gets bound as ascii_signal_name_to_portable_signal_id in:
//
// src/lib/std/src/nj/interprocess-signals-guts.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
char* signal_name = HEAP_STRING_AS_C_STRING( arg );
//
int signal_id = ascii_signal_name_to_portable_signal_id ( signal_name ); // ascii_name_to_portable_signal_id is from src/c/machine-dependent/interprocess-signals.c
//
Val result = TAGGED_INT_FROM_C_INT( signal_id );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
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_P_TTY_tcgetpgrp (Task* task, Val arg) {
//=====================
//
// Mythryl type: Int -> Int
//
// Get foreground process group id of tty.
//
// This fn gets bound as tcgetpgrp in:
//
// src/lib/std/src/posix-1003.1b/posix-tty.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_TTY_tcgetpgrp");
int fd = TAGGED_INT_TO_C_INT( arg );
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_TTY_tcgetpgrp", NULL );
//
int result = tcgetpgrp( fd );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_TTY_tcgetpgrp" );
return TAGGED_INT_FROM_C_INT( result );
}
Val _lib7_Sock_frominetaddr (Task* task, Val arg) {
//=======================
//
// Mythryl type: Internet_Address -> (Internet_Address, Int)
//
// Given a INET-domain socket address, return the INET address and port number.
//
// This fn gets bound as from_inet_addr in:
//
// src/lib/std/src/socket/internet-socket.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_Sock_frominetaddr");
struct sockaddr_in* addr
=
GET_VECTOR_DATACHUNK_AS( struct sockaddr_in*, arg ); // Last use of 'arg'.
ASSERT( addr->sin_family == AF_INET );
Val data = make_biwordslots_vector_sized_in_bytes__may_heapclean( task, &(addr->sin_addr), sizeof(struct in_addr), NULL );
Val inAddr = make_vector_header( task, UNT8_RO_VECTOR_TAGWORD, data, sizeof(struct in_addr) );
return make_two_slot_record(task, inAddr, TAGGED_INT_FROM_C_INT(ntohs(addr->sin_port)) );
}
Val _lib7_P_ProcEnv_getpgrp (Task* task, Val arg) {
//=======================
//
// Mythryl type: Void -> Int
//
// Return process group.
//
// This fn gets bound as get_process_group in:
//
// src/lib/std/src/psx/posix-id.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
int pgrp = getpgrp();
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
Val result = TAGGED_INT_FROM_C_INT( pgrp );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
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 raise_error__may_heapclean (
//==========================
//
Task* task,
const char* altMsg,
const char* at, // C sourcefile and line number raising this error: "<foo.c:37>"
Roots* extra_roots
) {
// Raise the Mythryl exception RUNTIME_EXCEPTION, which is defined as:
//
// exception RUNTIME_EXCEPTION (String, Null_Or(System_Error) );
//
// We normally get invoked via either the
// RAISE_SYSERR__MAY_HEAPCLEAN or RAISE_ERROR__MAY_HEAPCLEAN macro from
//
// src/c/lib/raise-error.h
//
// For the time being, we use the errno value as the System_Error; eventually that
// will be represented by an (Int, String) pair. If alt_msg is non-zero,
// then use it as the error string and use NULL for the System_Error.
int error_number = errno; // Various calls can trash this value so preserve it early.
const char* msg;
char buf[32];
Val null_or_errno;
if (altMsg != NULL) {
//
msg = altMsg;
null_or_errno = OPTION_NULL;
} else if ((msg = strerror(error_number)) != NULL) {
null_or_errno = OPTION_THE( task, TAGGED_INT_FROM_C_INT(error_number) );
} else {
sprintf(buf, "<unknown error %d>", error_number);
msg = buf;
null_or_errno = OPTION_THE( task, TAGGED_INT_FROM_C_INT(error_number) );
}
#if (defined(DEBUG_OS_INTERFACE) || defined(DEBUG_TRACE_CCALL))
debug_say ("RaiseSysError: errno = %d, msg = \"%s\"\n",
(altMsg != NULL) ? -1 : error_number, msg);
#endif
Roots roots1 = { &null_or_errno, extra_roots };
Val errno_string = make_ascii_string_from_c_string__may_heapclean (task, msg, &roots1 );
Val at_list; // [] or [ "<foo.c:187>" ].
//
if (at != NULL) {
//
Roots roots2 = { &errno_string, &roots1 };
Val at_cstring
=
make_ascii_string_from_c_string__may_heapclean (task, at, &roots2 );
at_list = LIST_CONS(task, at_cstring, LIST_NIL);
} else {
at_list = LIST_NIL;
}
Val arg = make_two_slot_record( task, errno_string, null_or_errno);
Val syserr_exception = MAKE_EXCEPTION(task, PTR_CAST( Val, RUNTIME_EXCEPTION__GLOBAL), arg, at_list);
// Modify the task state so that 'syserr_exception'
// will be raised when Mythryl execution resumes:
//
raise_mythryl_exception( task, syserr_exception ); // raise_mythryl_exception is from src/c/main/run-mythryl-code-and-runtime-eventloop.c
return syserr_exception;
} // fun raise_error__may_heapclean
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;
}
