static sexp sexp_vector_nreverse (sexp ctx, sexp vec) { int i, j; sexp tmp, *data=sexp_vector_data(vec); for (i=0, j=sexp_vector_length(vec)-1; i<j; i++, j--) swap(tmp, data[i], data[j]); return vec; }
static sexp sexp_vector_copy_to_list (sexp ctx, sexp vec, sexp seq) { sexp_sint_t i; sexp ls, *data=sexp_vector_data(vec); for (i=0, ls=seq; sexp_pairp(ls); i++, ls=sexp_cdr(ls)) sexp_car(ls) = data[i]; return seq; }
static sexp sexp_sort_x (sexp ctx sexp_api_params(self, n), sexp seq, sexp less, sexp key) { sexp_sint_t len; sexp res, *data; sexp_gc_var1(vec); if (sexp_nullp(seq)) return seq; sexp_gc_preserve1(ctx, vec); vec = (sexp_truep(sexp_listp(ctx, seq)) ? sexp_list_to_vector(ctx, seq) : seq); if (! sexp_vectorp(vec)) { res = sexp_type_exception(ctx, self, SEXP_VECTOR, vec); } else { data = sexp_vector_data(vec); len = sexp_vector_length(vec); if (sexp_not(key) && sexp_basic_comparator(less)) { sexp_qsort(ctx, data, 0, len-1); if (sexp_opcodep(less) && sexp_opcode_inverse(less)) sexp_vector_nreverse(ctx, vec); res = vec; } else if (! (sexp_procedurep(less) || sexp_opcodep(less))) { res = sexp_type_exception(ctx, self, SEXP_PROCEDURE, less); } else if (! (sexp_procedurep(key) || sexp_opcodep(key) || sexp_not(key))) { res = sexp_type_exception(ctx, self, SEXP_PROCEDURE, key); } else { res = sexp_qsort_less(ctx, data, 0, len-1, less, key); } } if (sexp_pairp(seq) && ! sexp_exceptionp(res)) res = sexp_vector_copy_to_list(ctx, vec, seq); sexp_gc_release1(ctx); return res; }
static sexp sexp_load_image (const char* file, sexp_uint_t heap_size, sexp_uint_t heap_max_size) { sexp ctx, flags, *globals, *types; int fd; sexp_sint_t offset; sexp_heap heap; sexp_free_list q; struct sexp_image_header_t header; fd = open(file, O_RDONLY); if (fd < 0) { fprintf(stderr, "can't open image file: %s\n", file); return NULL; } if (read(fd, &header, sizeof(header)) != sizeof(header)) return NULL; if (memcmp(header.magic, SEXP_IMAGE_MAGIC, sizeof(header.magic)) != 0) { fprintf(stderr, "invalid image file magic for %s: %s\n", file, header.magic); return NULL; } else if (header.major != SEXP_IMAGE_MAJOR_VERSION || header.major < SEXP_IMAGE_MINOR_VERSION) { fprintf(stderr, "unsupported image version: %d.%d\n", header.major, header.minor); return NULL; } else if (!sexp_abi_compatible(NULL, header.abi, SEXP_ABI_IDENTIFIER)) { fprintf(stderr, "unsupported ABI: %s (expected %s)\n", header.abi, SEXP_ABI_IDENTIFIER); return NULL; } if (heap_size < header.size) heap_size = header.size; heap = (sexp_heap)malloc(sexp_heap_pad_size(heap_size)); if (!heap) { fprintf(stderr, "couldn't malloc heap\n"); return NULL; } if (read(fd, heap, header.size) != header.size) { fprintf(stderr, "error reading image\n"); return NULL; } offset = (sexp_sint_t)((char*)heap - (sexp_sint_t)header.base); /* expand the last free chunk if necessary */ if (heap->size < heap_size) { for (q=(sexp_free_list)(((char*)heap->free_list) + offset); q->next; q=(sexp_free_list)(((char*)q->next) + offset)) ; if ((char*)q + q->size >= (char*)heap->data + heap->size) { /* last free chunk at end of heap */ q->size += heap_size - heap->size; } else { /* last free chunk in the middle of the heap */ q->next = (sexp_free_list)((char*)heap->data + heap->size); q = (sexp_free_list)(((char*)q->next) + offset); q->size = heap_size - heap->size; q->next = NULL; } heap->size += (heap_size - heap->size); } ctx = (sexp)(((char*)header.context) + offset); globals = sexp_vector_data((sexp)((char*)sexp_context_globals(ctx) + offset)); types = sexp_vector_data((sexp)((char*)(globals[SEXP_G_TYPES]) + offset)); flags = sexp_fx_add(SEXP_COPY_LOADP, SEXP_COPY_FREEP); sexp_offset_heap_pointers(heap, header.base, types, flags); close(fd); return ctx; }