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; } }