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)
}
/* _lib7_win32_IO_set_file_pointer: (one_word_unt * one_word_unt * one_word_unt) -> one_word_unt
* handle dist how
*/
Val _lib7_win32_IO_set_file_pointer(Task *task, Val arg)
{
HANDLE h = (HANDLE) WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg,0));
LONG dist = (LONG) WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg,1));
DWORD how = (DWORD) WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg,2));
Val_Sized_Unt w;
Val res;
w = SetFilePointer(h,dist,NULL,how);
WORD_ALLOC(task, res, w);
return res;
}
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;
}
/* _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 {
/* _lib7_P_FileSys_ftruncate_64 : (int * word32 * word32) -> Void
* fd lengthhi lengthlo
*
* Make a directory
*/
lib7_val_t _lib7_P_FileSys_ftruncate_64 (lib7_state_t *lib7_state, lib7_val_t arg)
{
int fd = REC_SELINT(arg, 0);
off_t len =
(sizeof(off_t) > 4)
? (((off_t)WORD_LIB7toC(REC_SEL(arg, 1))) << 32) |
((off_t)(WORD_LIB7toC(REC_SEL(arg, 2))))
: ((off_t)(WORD_LIB7toC(REC_SEL(arg, 2))));
int status;
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-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(lib7_state, status)
} /* end of _lib7_P_FileSys_ftruncate_64 */
/* _lib7_win32_IO_get_std_handle: one_word_unt -> one_word_unt
* interface to win32 GetStdHandle
*/
Val _lib7_win32_IO_get_std_handle(Task *task, Val arg)
{
Val_Sized_Unt w = WORD_LIB7toC(arg);
HANDLE h = GetStdHandle(w);
Val res;
#ifdef WIN32_DEBUG
debug_say("getting std handle for %x as %x\n", w, (unsigned int) h);
#endif
WORD_ALLOC(task, res, (Val_Sized_Unt)h);
return res;
}
/* _lib7_win32_IO_close: one_word_unt -> Void
* close a handle
*/
Val _lib7_win32_IO_close(Task *task, Val arg)
{
HANDLE h = (HANDLE) WORD_LIB7toC(arg);
if (CloseHandle(h)) {
return HEAP_VOID;
}
#ifdef WIN32_DEBUG
debug_say("_lib7_win32_IO_close: failing\n");
#endif
return RAISE_SYSERR(task,-1);
}
Val _lib7_P_ProcEnv_setgid (Task* task, Val arg) {
//======================
//
// Mythryl type: Unt -> Void
//
// Set group id.
//
// This fn gets bound as set_group_id in:
//
// src/lib/std/src/posix-1003.1b/posix-id.pkg
int status = setgid( WORD_LIB7toC( arg ));
//
CHECK_RETURN_UNIT(task, status)
}
Val _lib7_win32_PS_wait_for_single_chunk(Task *task, Val arg)
{
HANDLE hProcess = (HANDLE) WORD_LIB7toC (arg);
DWORD exit_code;
int res;
Val p;
res = WaitForSingleChunkect (hProcess,0);
if (res==WAIT_TIMEOUT || res==WAIT_FAILED) {
/* information is not ready, or error */
return OPTION_NULL;
} else {
/* WAIT_CHUNKECT_0 ... done, finished */
/* get info and return THE(exit_status) */
GetExitCodeProcess (hProcess,&exit_code);
CloseHandle (hProcess); /* decrease ref count */
p = make_one_word_unt(task, (Vunt) exit_code );
return OPTION_THE( task, p );
}
}
lib7_val_t _lib7_win32_PS_wait_for_single_chunk(lib7_state_t *lib7_state, lib7_val_t arg)
{
HANDLE hProcess = (HANDLE) WORD_LIB7toC (arg);
DWORD exit_code;
int res;
lib7_val_t p,chunk;
res = WaitForSingleChunkect (hProcess,0);
if (res==WAIT_TIMEOUT || res==WAIT_FAILED) {
/* information is not ready, or error */
chunk = OPTION_NONE;
}
else {
/* WAIT_CHUNKECT_0 ... done, finished */
/* get info and return THE(exit_status) */
GetExitCodeProcess (hProcess,&exit_code);
CloseHandle (hProcess); /* decrease ref count */
WORD_ALLOC (lib7_state,p,(Word_t)exit_code);
OPTION_SOME(lib7_state,chunk,p);
}
return chunk;
}
Val _lib7_P_ProcEnv_setgid (Task* task, Val arg) {
//======================
//
// Mythryl type: Unt -> Void
//
// Set group id.
//
// This fn gets bound as set_group_id in:
//
// src/lib/std/src/psx/posix-id.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, &arg );
//
int status = setgid( WORD_LIB7toC( arg ));
//
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;
}
/* _lib7_P_ProcEnv_setuid: word -> Void
*
* Set user id
*/
lib7_val_t _lib7_P_ProcEnv_setuid (lib7_state_t *lib7_state, lib7_val_t arg)
{
int status = setuid(WORD_LIB7toC(arg));
CHECK_RETURN_UNIT(lib7_state, status)
}
/* _lib7_win32_PS_exit_process : word32 -> 'a
* exit code
*
*/
void _lib7_win32_PS_exit_process(lib7_state_t *lib7_state, lib7_val_t arg)
{
ExitProcess((UINT)WORD_LIB7toC(arg));
}
/* _lib7_win32_PS_sleep : word32 -> Void
*
* Suspend execution for interval in MILLIseconds.
*/
lib7_val_t _lib7_win32_PS_sleep (lib7_state_t *lib7_state, lib7_val_t arg)
{
Sleep ((DWORD) WORD_LIB7toC(arg));
return LIB7_void;
}
/* _lib7_win32_PS_exit_process : one_word_unt -> 'a
* exit code
*
*/
void _lib7_win32_PS_exit_process(Task *task, Val arg)
{
ExitProcess((UINT)WORD_LIB7toC(arg));
}
/* _lib7_win32_PS_sleep : one_word_unt -> Void
*
* Suspend execution for interval in MILLIseconds.
*/
Val _lib7_win32_PS_sleep (Task *task, Val arg)
{
Sleep ((DWORD) WORD_LIB7toC(arg));
return HEAP_VOID;
}
