int ikarus_main(int argc, char** argv, char* boot_file){
if(! cpu_has_sse2()){
fprintf(stderr, "Ikarus Scheme cannot run on your computer because\n");
fprintf(stderr, "your CPU does not support the SSE2 instruction set.\n");
fprintf(stderr, "Refer to the Ikarus Scheme User's Guide for the\n");
fprintf(stderr, "minimum hardware requirements.\n");
exit(-1);
}
if(sizeof(mp_limb_t) != sizeof(long int)){
fprintf(stderr, "ERROR: limb size does not match\n");
exit(-1);
}
if(mp_bits_per_limb != (8*sizeof(long int))){
fprintf(stderr, "ERROR: invalid bits_per_limb=%d\n", mp_bits_per_limb);
exit(-1);
}
ikpcb* pcb = ik_make_pcb();
the_pcb = pcb;
{ /* set up arg_list */
ikptr arg_list = null_object;
int i = argc-1;
while(i > 0){
char* s = argv[i];
int n = strlen(s);
ikptr bv = ik_unsafe_alloc(pcb, align(disp_bytevector_data+n+1))
+ bytevector_tag;
ref(bv, off_bytevector_length) = fix(n);
memcpy((char*)(bv+off_bytevector_data), s, n+1);
ikptr p = ik_unsafe_alloc(pcb, pair_size);
ref(p, disp_car) = bv;
ref(p, disp_cdr) = arg_list;
arg_list = p+pair_tag;
i--;
}
pcb->arg_list = arg_list;
}
register_handlers();
register_alt_stack();
ik_fasl_load(pcb, boot_file);
/*
fprintf(stderr, "collect time: %d.%03d utime, %d.%03d stime (%d collections)\n",
pcb->collect_utime.tv_sec,
pcb->collect_utime.tv_usec/1000,
pcb->collect_stime.tv_sec,
pcb->collect_stime.tv_usec/1000,
pcb->collection_id );
*/
ik_delete_pcb(pcb);
return 0;
}
ikptr
ikrt_register_guardian(ikptr tc, ikptr obj, ikpcb* pcb){
ikptr p0 = ik_unsafe_alloc(pcb, pair_size) + pair_tag;
ref(p0, off_car) = tc;
ref(p0, off_cdr) = obj;
return ikrt_register_guardian_pair(p0, pcb);
}
void ik_stack_overflow(ikpcb* pcb){
#ifndef NDEBUG
fprintf(stderr, "entered ik_stack_overflow pcb=0x%016lx\n", (long int)pcb);
#endif
set_segment_type(pcb->stack_base, pcb->stack_size, data_mt, pcb);
ikptr frame_base = pcb->frame_base;
ikptr underflow_handler = ref(frame_base, -wordsize);
#ifndef NDEBUG
fprintf(stderr, "underflow_handler = 0x%08x\n", (int)underflow_handler);
#endif
/* capture continuation and set it as next_k */
ikptr k = ik_unsafe_alloc(pcb, align(continuation_size)) + vector_tag;
ref(k, -vector_tag) = continuation_tag;
ref(k, off_continuation_top) = pcb->frame_pointer;
ref(k, off_continuation_size) =
pcb->frame_base - pcb->frame_pointer - wordsize;
ref(k, off_continuation_next) = pcb->next_k;
pcb->next_k = k;
pcb->stack_base = (ikptr)(long)ik_mmap_typed(STAKSIZE, mainstack_mt, pcb);
pcb->stack_size = STAKSIZE;
pcb->frame_base = pcb->stack_base + pcb->stack_size;
pcb->frame_pointer = pcb->frame_base - wordsize;
pcb->frame_redline = pcb->stack_base + 2 * 4096;
ref(pcb->frame_pointer, 0) = underflow_handler;
return;
}
void
ik_enter_c_function (ikpcb_t* pcb)
/* We call this function whenever we enter a C function that may invoke
* a Scheme callback. Save into a system continuation the C stack that
* was last stored into PCB when entering Scheme code.
*
* Upon returning from this function, the Scheme stack is left as
* follows:
*
* high memory
* | |
* |----------------------|
* | | <- pcb->frame_base
* |----------------------|
* | ik_underflow_handler | <- pcb->frame_pointer
* |----------------------|
* | |
* low memory
*
* and to call "ik_exec_code()" we still need to set:
*
* pcb->frame_pointer = pcb->frame_base;
*
* because it is needed by the assembly routine that calls compiled code
* in a code object.
*/
{
ikptr_t sk;
seal_scheme_stack(pcb);
sk = ik_unsafe_alloc(pcb, IK_ALIGN(system_continuation_size)) | continuation_primary_tag;
IK_REF(sk, off_system_continuation_tag) = system_continuation_tag;
IK_REF(sk, off_system_continuation_top) = pcb->system_stack;
IK_REF(sk, off_system_continuation_next) = pcb->next_k;
pcb->next_k = sk;
}
ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr, ikptr argcount, ikptr cp) {
ikptr argc = ik_asm_enter(pcb, code_ptr+off_code_data, argcount, cp);
ikptr next_k = pcb->next_k;
while(next_k) {
cont* k = (cont*)(long)(next_k - vector_tag);
if (k->tag == system_continuation_tag) {
break;
}
ikptr top = k->top;
ikptr rp = ref(top, 0);
long int framesize = (long int) ref(rp, disp_frame_size);
#ifdef DEBUG_EXEC
fprintf(stderr, "exec framesize=0x%016lx ksize=%ld rp=0x%016lx\n",
framesize, k->size, rp);
#endif
if(framesize == 0) {
framesize = ref(top, wordsize);
}
if(framesize <= 0) {
fprintf(stderr, "invalid framesize %ld\n", framesize);
exit(-10);
}
if(framesize < k->size) {
cont* nk = (cont*)(long)ik_unsafe_alloc(pcb, sizeof(cont));
nk->tag = k->tag;
nk->next = k->next;
nk->top = top + framesize;
nk->size = k->size - framesize;
k->size = framesize;
k->next = vector_tag + (ikptr)(long)nk;
/* record side effect */
unsigned long int idx = ((unsigned long int)(&k->next)) >> pageshift;
((unsigned int*)(long)(pcb->dirty_vector))[idx] = -1;
} else if (framesize > k->size) {
ikptr_t
iku_pointer_alloc (ikpcb_t * pcb, ikuword_t memory)
{
ikptr_t s_pointer = ik_unsafe_alloc(pcb, pointer_size) | vector_tag;
IK_REF(s_pointer, off_pointer_tag) = pointer_tag;
IK_REF(s_pointer, off_pointer_data) = (ikptr_t)memory;
return s_pointer;
}
ikpcb* ik_make_pcb(){
ikpcb* pcb = ik_malloc(sizeof(ikpcb));
bzero(pcb, sizeof(ikpcb));
pcb->collect_key = false_object;
#define STAKSIZE (1024 * 4096)
//#define STAKSIZE (256 * 4096)
pcb->heap_base = ik_mmap(IK_HEAPSIZE);
pcb->heap_size = IK_HEAPSIZE;
pcb->allocation_pointer = pcb->heap_base;
pcb->allocation_redline = pcb->heap_base + IK_HEAPSIZE - 2 * 4096;
pcb->stack_base = ik_mmap(STAKSIZE);
pcb->stack_size = STAKSIZE;
pcb->frame_pointer = pcb->stack_base + pcb->stack_size;
pcb->frame_base = pcb->frame_pointer;
pcb->frame_redline = pcb->stack_base + 2 * 4096;
{ /* make cache ikpage */
ikpage* p = (ikpage*)(long)ik_mmap(CACHE_SIZE * sizeof(ikpage));
pcb->cached_pages_base = (ikptr)(long)p;
pcb->cached_pages_size = CACHE_SIZE * sizeof(ikpage);
ikpage* q = 0;
ikpage* e = p + CACHE_SIZE;
while(p < e){
p->next = q;
q = p;
p++;
}
pcb->uncached_pages = q;
}
{
/* compute extent of heap and stack */
ikptr lo_mem;
ikptr hi_mem;
if(pcb->heap_base < pcb->stack_base){
lo_mem = pcb->heap_base - pagesize;
hi_mem = pcb->stack_base + pcb->stack_size + pagesize;
} else {
lo_mem = pcb->stack_base - pagesize;
hi_mem = pcb->heap_base + pcb->heap_size + pagesize;
}
unsigned long int lo_seg = segment_index(lo_mem);
unsigned long int hi_seg = segment_index(hi_mem+segment_size-1);
unsigned long int vec_size = (hi_seg - lo_seg) * pagesize;
ikptr dvec = ik_mmap(vec_size);
bzero((char*)(long)dvec, vec_size);
pcb->dirty_vector_base = (unsigned int*)(long) dvec;
pcb->dirty_vector = (dvec - lo_seg * pagesize);
ikptr svec = ik_mmap(vec_size);
bzero((char*)(long)svec, vec_size);
pcb->segment_vector_base = (unsigned int*)(long)svec;
pcb->segment_vector = (unsigned int*)(long)(svec - lo_seg * pagesize);
pcb->memory_base = (ikptr)(lo_seg * segment_size);
pcb->memory_end = (ikptr)(hi_seg * segment_size);
set_segment_type(pcb->heap_base,
pcb->heap_size,
mainheap_mt,
pcb);
set_segment_type(pcb->stack_base,
pcb->stack_size,
mainstack_mt,
pcb);
}
/* initialize base rtd */
{
ikptr r = ik_unsafe_alloc(pcb, align(rtd_size)) + rtd_tag;
ref(r, off_rtd_rtd) = r;
ref(r, off_rtd_length) = (ikptr) (rtd_size-wordsize);
ref(r, off_rtd_name) = 0;
ref(r, off_rtd_fields) = 0;
ref(r, off_rtd_printer) = 0;
ref(r, off_rtd_symbol) = 0;
pcb->base_rtd = r;
}
return pcb;
}
ikptr_t
ik_exec_code (ikpcb_t * pcb, ikptr_t s_code, ikptr_t s_argcount, ikptr_t s_closure)
/* Execute Scheme code and all its continuations until no more
continuations are stored in the PCB or a system continuation is found
in the continuations linked list.
S_CODE is a tagged memory pointer referencing the code object
implementing S_CLOSURE, if any.
S_ARGCOUNT is a fixnum representing the negated number of Scheme
arguments.
S_CLOSURE is a reference to the closure object to execute; it can be
the fixnum zero if there is no closure to execute, as when we enter a
loaded FASL file.
Return the return value of the last executed continuation. */
{
/* A fixnum representing the negated number of returned Scheme values.
It can be zero. */
ikptr_t s_retval_count;
/* Reference to the continuation object representing the C or Scheme
continuation we want to go back to. */
ikptr_t s_kont;
if (0 || DEBUG_EXEC) {
ik_debug_message_no_newline("%s: enter closure 0x%016lx, code 0x%016lx, annotation: ",
__func__, (long)s_closure, (long) s_code);
ik_fprint(stderr, IK_REF(s_code, off_code_annotation));
fprintf(stderr, "\n");
}
/* Enter compiled Scheme code.
Before and after we assert that the frame pointer equals the frame
base; this constraint on the Scheme stack is needed by the assembly
routine "ik_asm_enter". It is responsibility of the caller of
"ik_exec_code()" to set the Scheme stack appropriately. */
{
assert(pcb->frame_base == pcb->frame_pointer);
s_retval_count = ik_asm_enter(pcb, IK_CODE_ENTRY_POINT(s_code), s_argcount, s_closure);
assert(pcb->frame_base == pcb->frame_pointer);
}
/* Loop until there are continuations to be reinstated. */
for (s_kont = pcb->next_k; s_kont; s_kont = pcb->next_k) {
#ifndef NDEBUG
{
/* Assert that the situation on the Scheme stack is:
*
* high memory
* | | <- pcb->frame_pointer = pcb->frame_base
* |----------------------|
* | ik_underflow_handler | <- pcb->frame_pointer - wordsize
* |----------------------|
* | return value 0 |
* |----------------------|
* | return value 1 |
* |----------------------|
* | return value 2 |
* |----------------------|
* | |
* low memory
*
* Of course we cannot check for the presence of return values.
*/
ikptr_t underflow_handler;
assert(pcb->frame_base == pcb->frame_pointer);
underflow_handler = *(ikptr_t *)(pcb->frame_pointer - wordsize);
assert(IK_UNDERFLOW_HANDLER == underflow_handler);
}
#endif
assert(IK_IS_ANY_CONTINUATION(s_kont));
if (0 || DEBUG_EXEC) {
ik_debug_message("%s: resuming process continuation s_kont=0x%016lx",
__func__, (long)s_kont);
}
ikcont_t * kont = IK_CONTINUATION_STRUCT(s_kont);
/* System continuations are created by the FFI to save the current C
execution contest just before calling back a Scheme function. So
if S_KONT is a system continuation: we have no Scheme code to go
back to, we just return to the caller of this C function. It is
responsibility of such caller to reinstate the continuation to C
code. */
if (system_continuation_tag == kont->tag)
break;
assert(continuation_tag == kont->tag);
/* RETURN_ADDRESS is a raw memory address being the entry point in
machine code we have to jump back to. */
ikptr_t return_address = IK_REF(kont->top, 0);
/* FRAMESIZE is stack frame size of the function we have to return
to. This value was computed at compile time and stored in binary
code just before the "call" instruction. */
iksword_t framesize = IK_CALLTABLE_FRAMESIZE(return_address);
if (0 || DEBUG_EXEC) {
ik_debug_message("%s: framesize=%ld kont->size=%ld return_address=0x%016lx",
__func__, framesize, kont->size, return_address);
}
/* A continuation object can never have the underflow handler as
return address of the top stack frame; if it has it: it is a
wrongly generated continuation object. Wrong continuation
generation is the problem of issue #35, so we react specially
here by logging the state. */
if (IK_UNDERFLOW_HANDLER == return_address) {
ik_exec_code_log_and_abort(pcb, s_kont);
}
/* Zero framesize means that we are returning to a continuation
having as topmost stack frame a frame whose size could not be
computed at compile time. In such cases the framesize field in
the call table is set to zero and the actual stack frame size is
computed at runtime and pushed on the stack frame itself before
performing a "call" assembly instruction. */
if (0 == framesize) {
framesize = IK_REF(kont->top, wordsize);
}
/* Perform some framesize validations. If these happen it means
that there is a bug in Vicare. */
{
if (framesize <= 0) {
ik_abort("invalid caller function framesize %ld\n", framesize);
}
if (framesize > kont->size) {
ik_exec_code_log_and_abort(pcb, s_kont);
}
}
if (framesize < kont->size) {
/* The process continuation we have to reinstate references 2 or
more freezed frames. Mutate S_KONT to reference only the
topmost freezed frame and create a new continuation object
referencing the rest of the freezed frames. Register the
"rest" continuation as "next process continuation". */
ikcont_t * rest_kont = (ikcont_t*)ik_unsafe_alloc(pcb, IK_ALIGN(continuation_size));
ikptr_t s_rest_kont = (ikptr_t)(((ikuword_t)rest_kont) | continuation_primary_tag);
rest_kont->tag = continuation_tag;
rest_kont->next = kont->next;
rest_kont->top = kont->top + framesize;
rest_kont->size = kont->size - framesize;
kont->size = framesize;
kont->next = s_rest_kont;
/* FIXME Is it required to signal dirt for both the fields? Or it
always happens that a continuation object's memory block is
fully in a single page? In the original Ikarus code only the
"kont->next" dirt was registered, but debugging of Issue #35 is
making me paranoid. (Marco Maggi; Wed Mar 27, 2013) */
IK_SIGNAL_DIRT_IN_PAGE_OF_POINTER(pcb, &(kont->size));
IK_SIGNAL_DIRT_IN_PAGE_OF_POINTER(pcb, &(kont->next));
{ /* Special validations to ease debugging of issue #35. */
if (0 == kont->size) {
ik_debug_message("%s: next continuation with zero size 0x%016lx,\n\
\tframe return address=0x%016lx",
__func__, s_kont, IK_REF(kont->top, 0));
}
if (0 == rest_kont->size) {
ik_debug_message("%s: rest continuation with zero size 0x%016lx,\n\
\ttop frame return address=0x%016lx",
__func__, s_rest_kont, IK_REF(rest_kont->top, 0));
}
}
static void
seal_scheme_stack(ikpcb_t* pcb)
/* Freeze the current Scheme stack into a continuation object, unless
* the stack segment is empty.
*
* Example: let's say that, when arriving here, there are 2 stack
* frames; the situation on the Scheme stack is as follows:
*
* high memory
* | |
* |----------------------|
* | | <- pcb->frame_base
* |----------------------| --
* | ik_underflow_handler | .
* |----------------------| -- .
* | local value 1 | . .
* |----------------------| . .
* | local value 1 | . frame 1 .
* |----------------------| . . stack
* | return address 1 | . . segment
* |----------------------| -- .
* | local value 0 | . .
* |----------------------| . .
* | local value 0 | . frame 0 .
* |----------------------| . .
* | return address 0 | <- pcb->frame_pointer . .
* |----------------------| -- --
* | |
* low memory
*
* and we seal the stack as follows:
*
* high memory
* | |
* |----------------------|
* | ik_underflow_handler |
* |----------------------| --
* | local value 1 | .
* |----------------------| .
* | local value 1 | .
* |----------------------| .
* | return address 1 | . continuation
* |----------------------| . size
* | local value 0 | .
* |----------------------| .
* | local value 0 | .
* |----------------------| .
* | return address 0 | <- pcb->frame_base .
* |----------------------| --
* | ik_underflow_handler | <- pcb->frame_pointer . stack segment
* |----------------------| --
* | |
* low memory
*
* Example: let's say that, when arriving here, there are no stack
* frames; the situation on the Scheme stack is as follows:
*
* high memory
* | |
* |----------------------|
* | | <- pcb->frame_base
* |----------------------| --
* | ik_underflow_handler | <- pcb->frame_pointer . stack segment
* |----------------------| --
* | |
* low memory
*
* in this case we do nothing.
*
* FIXME Handle stack overflow. (Abdulaziz Ghuloum)
*/
{
if ((pcb->frame_base - wordsize) != pcb->frame_pointer) {
assert(IK_UNDERFLOW_HANDLER == IK_REF(pcb->frame_base, -wordsize));
ikcont_t * kont = (ikcont_t*)ik_unsafe_alloc(pcb, IK_ALIGN(continuation_size));
ikptr_t s_kont = ((ikptr_t)kont) | continuation_primary_tag;
kont->tag = continuation_tag;
kont->top = pcb->frame_pointer;
kont->size = (pcb->frame_base - wordsize) - pcb->frame_pointer;
kont->next = pcb->next_k;
pcb->next_k = s_kont;
pcb->frame_base = pcb->frame_pointer;
pcb->frame_pointer = pcb->frame_base - wordsize;
IK_REF(pcb->frame_pointer, 0) = IK_UNDERFLOW_HANDLER;
}
}
