/* _lib7_Sock_recvbuffrom * : (socket * rw_unt8_vector.Rw_Vector * int * int * Bool * Bool) -> (int * addr) * * The arguments are: socket, data buffer, start position, number of * bytes, OOB flag and peek flag. The result is number of bytes read and * the source address. * * This function gets imported into the Mythryl world via: * src/lib/std/src/socket/socket-guts.pkg */ lib7_val_t _lib7_Sock_recvbuffrom (lib7_state_t *lib7_state, lib7_val_t arg) { char addrBuf[MAX_SOCK_ADDR_SZB]; int addrLen = MAX_SOCK_ADDR_SZB; int socket = REC_SELINT(arg, 0); lib7_val_t buf = REC_SEL(arg, 1); int nbytes = REC_SELINT(arg, 3); char *start = STR_LIB7toC(buf) + REC_SELINT(arg, 2); int flag = 0; int n; if (REC_SEL(arg, 4) == LIB7_true) flag |= MSG_OOB; if (REC_SEL(arg, 5) == LIB7_true) flag |= MSG_PEEK; /* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */ n = recvfrom (socket, start, nbytes, flag, (struct sockaddr *)addrBuf, &addrLen); /* } while (n < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */ if (n < 0) return RAISE_SYSERR(lib7_state, status); else { lib7_val_t data = LIB7_CData (lib7_state, addrBuf, addrLen); lib7_val_t addr, res; SEQHDR_ALLOC (lib7_state, addr, DESC_word8vec, data, addrLen); REC_ALLOC2(lib7_state, res, INT_CtoLib7(n), addr); return res; } } /* end of _lib7_Sock_recvbuffrom */
/* RaiseSysError: * * Raise the Lib7 exception SysErr, which has the spec: * * exception SYSTEM_ERROR of (String * System_Error Null_Or) * * We use the last win32-api error 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. */ lib7_val_t RaiseSysError (lib7_state_t *lib7_state, const char *altMsg, char *at) { lib7_val_t s, syserror, arg, exn, atStk; const char *msg; char buf[32]; int errno = -1; if (altMsg != NULL) { msg = altMsg; syserror = OPTION_NONE; } else { errno = (int) GetLastError(); sprintf(buf, "<win32 error code %d>", errno); msg = buf; OPTION_SOME(lib7_state, syserror, INT_CtoLib7(errno)); } s = LIB7_CString (lib7_state, msg); if (at != NULL) { lib7_val_t atMsg = LIB7_CString (lib7_state, at); LIST_cons(lib7_state, atStk, atMsg, LIST_nil); } else atStk = LIST_nil; REC_ALLOC2 (lib7_state, arg, s, syserror); EXN_ALLOC (lib7_state, exn, PTR_CtoLib7(SysErrId), arg, atStk); RaiseLib7Exception (lib7_state, exn); return exn; } /* end of RaiseSysError */
lib7_val_t c_exp(lib7_state_t *lib7_state, lib7_val_t arg) { double d; lib7_val_t result; extern int errno; Save_LIB7_FPState(); Restore_C_FPState(); errno = 0; d = exp(*(PTR_LIB7toC(double,arg))); REAL_ALLOC(lib7_state,result,d); REC_ALLOC2(lib7_state,result,result,INT_CtoLib7(errno)); Restore_LIB7_FPState(); return result; }
/* _lib7_OpenCV_cvLoadImage : String -> Image * */ Val _lib7_OpenCV_cvLoadImage (Task *task, Val arg) { #if HAVE_OPENCV_CV_H && HAVE_LIBCV char* filename = HEAP_STRING_AS_C_STRING( arg ); IplImage* ipl_image = cvLoadImage( filename, CV_LOAD_IMAGE_UNCHANGED ); if (!ipl_image) RAISE_ERROR(task, "cvLoadImage returned NULL"); { // Copy image into heap, so that it can be // garbage-collected when no longer needed: // Val header; Val header_data; Val image; Val image_data; Val result; header_data = make_int2_vector_sized_in_bytes( task, ipl_image, sizeof(IplImage)); SEQHDR_ALLOC(task, header, UNT8_RO_VECTOR_TAGWORD, header_data, sizeof(IplImage)); c_roots__global[c_roots_count__global++] = &header; // Protect header from garbage collection while allocating image. image_data = make_int2_vector_sized_in_bytes( task, ipl_image->imageData, ipl_image->imageSize); SEQHDR_ALLOC(task, image, UNT8_RO_VECTOR_TAGWORD, image_data, ipl_image->imageSize); --c_roots_count__global; cvReleaseImage( &ipl_image ); REC_ALLOC2(task, result, header, image); return result; } #else extern char* no_opencv_support_in_runtime; return RAISE_ERROR(task, no_opencv_support_in_runtime); #endif }
/* _lib7_Sock_socketpair : (int * int * int) -> (socket * socket) * * Create a pair of sockets. The arguments are: domain (should be * AF_UNIX), type, and protocol. * * This function gets imported into the Mythryl world via: * src/lib/std/src/socket/generic-socket.pkg */ lib7_val_t _lib7_Sock_socketpair (lib7_state_t *lib7_state, lib7_val_t arg) { int domain = REC_SELINT(arg, 0); int type = REC_SELINT(arg, 1); int protocol = REC_SELINT(arg, 2); int status; int socket[2]; status = socketpair (domain, type, protocol, socket); if (status < 0) { return RAISE_SYSERR(lib7_state, status); } else { lib7_val_t res; REC_ALLOC2(lib7_state, res, INT_CtoLib7(socket[0]), INT_CtoLib7(socket[1])); return res; } } /* end of _lib7_Sock_socketpair */
/* _lib7_Sock_accept : Socket -> (Socket, Address) * * This function gets imported into the Mythryl world via: * src/lib/std/src/socket/socket-guts.pkg */ lib7_val_t _lib7_Sock_accept (lib7_state_t *lib7_state, lib7_val_t arg) { int socket = INT_LIB7toC(arg); char addrBuf[MAX_SOCK_ADDR_SZB]; int addrLen = MAX_SOCK_ADDR_SZB; int newSock; /* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */ newSock = accept (socket, (struct sockaddr *)addrBuf, &addrLen); /* } while (newSock < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */ if (newSock == -1) { return RAISE_SYSERR(lib7_state, newSock); } else { lib7_val_t data = LIB7_CData (lib7_state, addrBuf, addrLen); lib7_val_t addr, res; SEQHDR_ALLOC(lib7_state, addr, DESC_word8vec, data, addrLen); REC_ALLOC2(lib7_state, res, INT_CtoLib7(newSock), addr); return res; } }
/* LIB7_Poll: * * The version of the polling operation for systems that provide SVR4 polling. */ static lib7_val_t LIB7_Poll (lib7_state_t *lib7_state, lib7_val_t poll_list, struct timeval *timeout) { int tout; struct pollfd* fds; struct pollfd* fdp; int nfds, i, flag; lib7_val_t l, item; if (timeout == NULL) tout = -1; else /* Convert to miliseconds: */ tout = (timeout->tv_sec * 1000) + (timeout->tv_usec / 1000); /* Count the number of polling items: */ for (l = poll_list, nfds = 0; l != LIST_nil; l = LIST_tl(l)) nfds++; /* Allocate the fds vector: */ fds = NEW_VEC(struct pollfd, nfds); CLEAR_MEM (fds, sizeof(struct pollfd)*nfds); /* Initialize the polling descriptors: */ for (l = poll_list, fdp = fds; l != LIST_nil; l = LIST_tl(l), fdp++) { item = LIST_hd(l); fdp->fd = REC_SELINT(item, 0); flag = REC_SELINT(item, 1); if ((flag & READABLE_BIT) != 0) fdp->events |= POLLIN; if ((flag & WRITABLE_BIT) != 0) fdp->events |= POLLOUT; if ((flag & OOBDABLE_BIT) != 0) fdp->events |= POLL_ERROR; } { int status; /* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */ status = poll (fds, nfds, tout); /* } while (status < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */ if (status < 0) { FREE(fds); return RAISE_SYSERR(lib7_state, status); } else { for (i = nfds-1, l = LIST_nil; i >= 0; i--) { fdp = &(fds[i]); if (fdp->revents != 0) { flag = 0; if ((fdp->revents & POLLIN ) != 0) flag |= READABLE_BIT; if ((fdp->revents & POLLOUT ) != 0) flag |= WRITABLE_BIT; if ((fdp->revents & POLL_ERROR) != 0) flag |= OOBDABLE_BIT; REC_ALLOC2(lib7_state, item, INT_CtoLib7(fdp->fd), INT_CtoLib7(flag)); LIST_cons(lib7_state, l, item, l); } } FREE(fds); return l; } } }
/* LIB7_Poll: * * The version of the polling operation for systems that provide BSD select. */ static lib7_val_t LIB7_Poll (lib7_state_t *lib7_state, lib7_val_t poll_list, struct timeval *timeout) { fd_set rset, wset, eset; fd_set *rfds, *wfds, *efds; int maxFD, status, fd, flag; lib7_val_t l, item; /*printf("src/runtime/c-libs/posix-os/poll.c: Using 'select' implementation\n");*/ rfds = wfds = efds = NULL; maxFD = 0; for (l = poll_list; l != LIST_nil; l = LIST_tl(l)) { item = LIST_hd(l); fd = REC_SELINT(item, 0); flag = REC_SELINT(item, 1); if ((flag & READABLE_BIT) != 0) { /*int fd_flags = fcntl(fd,F_GETFL,0);*/ if (rfds == NULL) { rfds = &rset; FD_ZERO(rfds); } /*printf("src/runtime/c-libs/posix-os/poll.c: Will check fd %d for readability. fd flags x=%x O_NONBLOCK x=%x\n",fd,fd_flags,O_NONBLOCK);*/ FD_SET (fd, rfds); } if ((flag & WRITABLE_BIT) != 0) { if (wfds == NULL) { wfds = &wset; FD_ZERO(wfds); } /*printf("src/runtime/c-libs/posix-os/poll.c: Will check fd %d for writability.\n",fd);*/ FD_SET (fd, wfds); } if ((flag & OOBDABLE_BIT) != 0) { if (efds == NULL) { efds = &eset; FD_ZERO(efds); } /*printf("src/runtime/c-libs/posix-os/poll.c: Will check fd %d for oobdability.\n",fd);*/ FD_SET (fd, efds); } if (fd > maxFD) maxFD = fd; } /*printf("src/runtime/c-libs/posix-os/poll.c: maxFD d=%d timeout x=%x.\n",maxFD,timeout);*/ /* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */ status = select (maxFD+1, rfds, wfds, efds, timeout); /* } while (status < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */ /*printf("src/runtime/c-libs/posix-os/poll.c: result status d=%d.\n",status);*/ if (status < 0) return RAISE_SYSERR(lib7_state, status); else if (status == 0) return LIST_nil; else { lib7_val_t *resVec = NEW_VEC(lib7_val_t, status); int i; int resFlag; for (i = 0, l = poll_list; l != LIST_nil; l = LIST_tl(l)) { item = LIST_hd(l); fd = REC_SELINT(item, 0); flag = REC_SELINT(item, 1); resFlag = 0; if (((flag & READABLE_BIT) != 0) && FD_ISSET(fd, rfds)) { /*int fd_flags = fcntl(fd,F_GETFL,0);*/ /*printf("src/runtime/c-libs/posix-os/poll.c: fd d=%d is in fact readable. fd flags x=%x O_NONBLOCK x=%x\n",fd,fd_flags,O_NONBLOCK);*/ resFlag |= READABLE_BIT; } if (((flag & WRITABLE_BIT) != 0) && FD_ISSET(fd, wfds)) { /*printf("src/runtime/c-libs/posix-os/poll.c: fd d=%d is in fact writable.\n",fd);*/ resFlag |= WRITABLE_BIT; } if (((flag & OOBDABLE_BIT) != 0) && FD_ISSET(fd, efds)) { /*printf("src/runtime/c-libs/posix-os/poll.c: fd d=%d is in fact oobdable.\n",fd);*/ resFlag |= OOBDABLE_BIT; } if (resFlag != 0) { REC_ALLOC2 (lib7_state, item, INT_CtoLib7(fd), INT_CtoLib7(resFlag)); resVec[i++] = item; } } ASSERT(i == status); for (i = status-1, l = LIST_nil; i >= 0; i--) { item = resVec[i]; LIST_cons (lib7_state, l, item, l); } FREE(resVec); return l; } } /* end of LIB7_Poll */
/* ImportHeapImage: */ lib7_state_t *ImportHeapImage (const char *fname, heap_params_t *params) { lib7_state_t *lib7_state; lib7_image_hdr_t imHdr; lib7_heap_hdr_t heapHdr; lib7_val_t *externs; lib7_vproc_image_t image; inbuf_t inBuf; if (fname != NULL) { /* Resolve the name of the image. * If the file exists use it, otherwise try the * pathname with the machine ID as an extension. */ if ((inBuf.file = fopen(fname, "rb"))) { if (verbosity > 0) say("loading %s ", fname); } else { if ((inBuf.file = fopen(fname, "rb"))) { if (verbosity > 0) say("loading %s ", fname); } else { Die ("unable to open heap image \"%s\"\n", fname); } } inBuf.needsSwap = FALSE; inBuf.buf = NULL; inBuf.nbytes = 0; } else { /* fname == NULL, so try to find an in-core heap image */ #if defined(DLOPEN) && !defined(OPSYS_WIN32) void *lib = dlopen (NULL, RTLD_LAZY); void *vimg, *vimglenptr; if ((vimg = dlsym(lib,HEAP_IMAGE_SYMBOL)) == NULL) Die("no in-core heap image found\n"); if ((vimglenptr = dlsym(lib,HEAP_IMAGE_LEN_SYMBOL)) == NULL) Die("unable to find length of in-core heap image\n"); inBuf.file = NULL; inBuf.needsSwap = FALSE; inBuf.base = vimg; inBuf.buf = inBuf.base; inBuf.nbytes = *(long*)vimglenptr; #else Die("in-core heap images not implemented\n"); #endif } READ(&inBuf, imHdr); if (imHdr.byteOrder != ORDER) Die ("incorrect byte order in heap image\n"); if (imHdr.magic != IMAGE_MAGIC) Die ("bad magic number (%#x) in heap image\n", imHdr.magic); if ((imHdr.kind != EXPORT_HEAP_IMAGE) && (imHdr.kind != EXPORT_FN_IMAGE)) Die ("bad image kind (%d) in heap image\n", imHdr.kind); READ(&inBuf, heapHdr); /* Check for command-line overrides of heap parameters: */ if (params->allocSz == 0) params->allocSz = heapHdr.allocSzB; if (params->numGens < heapHdr.numGens) params->numGens = heapHdr.numGens; if (params->cacheGen < 0) params->cacheGen = heapHdr.cacheGen; lib7_state = AllocLib7state (FALSE, params); /* Get the run-time pointers into the heap: */ *PTR_LIB7toC(lib7_val_t, PervasiveStruct) = heapHdr.pervasiveStruct; runtimeCompileUnit = heapHdr.runtimeCompileUnit; #ifdef ASM_MATH MathVec = heapHdr.mathVec; #endif /* Read the externals table: */ externs = HeapIO_ReadExterns (&inBuf); /* Read and initialize the Lib7 state info: */ READ(&inBuf, image); if (imHdr.kind == EXPORT_HEAP_IMAGE) { /* Load the live registers */ ASSIGN(Lib7SignalHandler, image.sigHandler); lib7_state->lib7_argument = image.stdArg; lib7_state->lib7_fate = image.stdCont; lib7_state->lib7_closure = image.stdClos; lib7_state->lib7_program_counter= image.pc; lib7_state->lib7_exception_fate = image.exception_fate; lib7_state->lib7_current_thread = image.current_thread; lib7_state->lib7_calleeSave[0] = image.calleeSave[0]; lib7_state->lib7_calleeSave[1] = image.calleeSave[1]; lib7_state->lib7_calleeSave[2] = image.calleeSave[2]; /* Read the Lib7 heap */ read_heap (&inBuf, &heapHdr, lib7_state, externs); /* GC message are on by default for interactive images */ /* GCMessages = TRUE; */ } else { /* EXPORT_FN_IMAGE */ lib7_val_t funct, cmdName, args; /* Restore the signal handler: */ ASSIGN(Lib7SignalHandler, image.sigHandler); /* Read the Lib7 heap: */ lib7_state->lib7_argument = image.stdArg; read_heap (&inBuf, &heapHdr, lib7_state, externs); /* Initialize the calling context (taken from ApplyLib7Fn) */ funct = lib7_state->lib7_argument; lib7_state->lib7_exception_fate = PTR_CtoLib7(handle_v+1); lib7_state->lib7_current_thread = LIB7_void; lib7_state->lib7_fate = PTR_CtoLib7(return_c); lib7_state->lib7_closure = funct; lib7_state->lib7_program_counter= lib7_state->lib7_link_register = GET_CODE_ADDR(funct); /* Set up the arguments to the imported function */ cmdName = LIB7_CString(lib7_state, Lib7CommandName); args = LIB7_CStringList (lib7_state, commandline_arguments); REC_ALLOC2(lib7_state, lib7_state->lib7_argument, cmdName, args); /* SayDebug("arg = %#x : [%#x, %#x]\n", lib7_state->lib7_argument, REC_SEL(lib7_state->lib7_argument, 0), REC_SEL(lib7_state->lib7_argument, 1)); */ /* GC message are off by default for spawn_to_disk images */ GCMessages = FALSE; } FREE (externs); if (inBuf.file) fclose (inBuf.file); if (verbosity > 0) say(" done\n"); return lib7_state; } /* ImportHeapImage */
Task* import_heap_image (const char* fname, Heapcleaner_Args* params) { // ================= // Task* task; Heapfile_Header image_header; Heap_Header heap_header; Val *externs; Pthread_Image image; Inbuf inbuf; if (fname != NULL) { // // Resolve the name of the image. // If the file exists use it, otherwise try the // pathname with the machine ID as an extension. if ((inbuf.file = fopen(fname, "rb"))) { // if (verbosity > 0) say("loading %s ", fname); } else { // if ((inbuf.file = fopen(fname, "rb"))) { // if (verbosity > 0) say("loading %s ", fname); } else { die ("unable to open heap image \"%s\"\n", fname); } } inbuf.needs_to_be_byteswapped = FALSE; inbuf.buf = NULL; inbuf.nbytes = 0; } else { // // fname == NULL, so try to find // an in-core heap image: #if defined(DLOPEN) && !defined(OPSYS_WIN32) // void *lib = dlopen (NULL, RTLD_LAZY); void *vimg, *vimglenptr; if ((vimg = dlsym(lib,HEAP_IMAGE_SYMBOL )) == NULL) die("no in-core heap image found\n"); if ((vimglenptr = dlsym(lib,HEAP_IMAGE_LEN_SYMBOL)) == NULL) die("unable to find length of in-core heap image\n"); inbuf.file = NULL; inbuf.needs_to_be_byteswapped = FALSE; inbuf.base = vimg; inbuf.buf = inbuf.base; inbuf.nbytes = *(long*)vimglenptr; #else die("in-core heap images not implemented\n"); #endif } READ(&inbuf, image_header); if (image_header.byte_order != ORDER) die ("incorrect byte order in heap image\n"); if (image_header.magic != IMAGE_MAGIC) die ("bad magic number (%#x) in heap image\n", image_header.magic); if ((image_header.kind != EXPORT_HEAP_IMAGE) && (image_header.kind != EXPORT_FN_IMAGE)) die ("bad image kind (%d) in heap image\n", image_header.kind); READ(&inbuf, heap_header); // Check for command-line overrides of heap parameters: // if (params->agegroup0_buffer_bytesize == 0) { params->agegroup0_buffer_bytesize = heap_header.agegroup0_buffer_bytesize; } if (params->active_agegroups < heap_header.active_agegroups) { params->active_agegroups = heap_header.active_agegroups; } if (params->oldest_agegroup_keeping_idle_fromspace_buffers < 0) { params->oldest_agegroup_keeping_idle_fromspace_buffers = heap_header.oldest_agegroup_keeping_idle_fromspace_buffers; } task = make_task( FALSE, params ); // make_task def in src/c/main/runtime-state.c // Get the run-time pointers into the heap: // *PTR_CAST( Val*, PERVASIVE_PACKAGE_PICKLE_LIST_REFCELL__GLOBAL ) = heap_header.pervasive_package_pickle_list; // This carefully constructed fake looks like a normal // compiled package from the Mythryl side but actually // links to compile C code -- see the hack in // // src/c/main/load-compiledfiles.c // runtime_package__global = heap_header.runtime_pseudopackage; #ifdef ASM_MATH mathvec__global = heap_header.math_package; #endif externs = heapio__read_externs_table (&inbuf); // Read the externals table. READ(&inbuf, image); // Read and initialize the Mythryl state info. // if (image_header.kind == EXPORT_HEAP_IMAGE) { // Load the live registers: // ASSIGN( POSIX_INTERPROCESS_SIGNAL_HANDLER_REFCELL__GLOBAL, image.posix_interprocess_signal_handler ); // task->argument = image.stdArg; task->fate = image.stdCont; task->current_closure = image.stdClos; task->program_counter = image.pc; task->exception_fate = image.exception_fate; task->current_thread = image.current_thread; // task->callee_saved_registers[0] = image.calleeSave[0]; task->callee_saved_registers[1] = image.calleeSave[1]; task->callee_saved_registers[2] = image.calleeSave[2]; read_heap (&inbuf, &heap_header, task, externs); // Read the Mythryl heap. /* cleaner_messages_are_enabled__global = TRUE; */ // Cleaning messages are on by default for interactive images. } else { // EXPORT_FN_IMAGE Val function_to_run; Val program_name; Val args; // Restore the signal handler: // ASSIGN( POSIX_INTERPROCESS_SIGNAL_HANDLER_REFCELL__GLOBAL, image.posix_interprocess_signal_handler ); // Read the Mythryl heap: // task->argument = image.stdArg; read_heap (&inbuf, &heap_header, task, externs); // Initialize the calling context (taken from run_mythryl_function): // run_mythryl_function def in src/c/main/run-mythryl-code-and-runtime-eventloop.c // function_to_run = task->argument; // task->exception_fate = PTR_CAST( Val, handle_uncaught_exception_closure_v + 1 ); task->current_thread = HEAP_VOID; // task->fate = PTR_CAST( Val, return_to_c_level_c ); task->current_closure = function_to_run; // task->program_counter = task->link_register = GET_CODE_ADDRESS_FROM_CLOSURE( function_to_run ); // Set up the arguments to the imported function: // program_name = make_ascii_string_from_c_string(task, mythryl_program_name__global); args = make_ascii_strings_from_vector_of_c_strings (task, commandline_arguments); REC_ALLOC2(task, task->argument, program_name, args); // debug_say("arg = %#x : [%#x, %#x]\n", task->argument, GET_TUPLE_SLOT_AS_VAL(task->argument, 0), GET_TUPLE_SLOT_AS_VAL(task->argument, 1)); // Cleaner messages are off by // default for spawn_to_disk images: // cleaner_messages_are_enabled__global = FALSE; } FREE( externs ); if (inbuf.file) fclose (inbuf.file); if (verbosity > 0) say(" done\n"); return task; } // fun import_heap_image