コード例 #1
0
ファイル: ipcLisp.c プロジェクト: StoneAerospace/ipc
/* Find string with the given enumerated value, and copy the string into
   the (already allocated) LISP vector */
char *enumValNameString (CONST_FORMAT_PTR format, int32 enumVal)
{
  char *name;

  if (format->formatter.a[0].i > 2 &&
      0 <= enumVal && enumVal <= ENUM_MAX_VAL(format)) {
    name = format->formatter.a[enumVal+2].f->formatter.name;
    BCOPY(name, (char *)Vecdata(SymbolValue(lisp_value(0))), strlen(name));
  }  
  return (char *)SymbolValue(lisp_value(0));
}
コード例 #2
0
ファイル: os-common.c プロジェクト: alexchonglian/sbcl
void os_link_runtime()
{
    lispobj head;
    void *link_target = (void*)(intptr_t)LINKAGE_TABLE_SPACE_START;
    void *validated_end = link_target;
    lispobj symbol_name;
    char *namechars;
    boolean datap;
    void* result;
    int strict /* If in a cold core, fail early and often. */
      = (SymbolValue(GC_INHIBIT, 0) & WIDETAG_MASK) == UNBOUND_MARKER_WIDETAG;
    int n = 0, m = 0;

    for (head = SymbolValue(REQUIRED_RUNTIME_C_SYMBOLS,0);
         head!=NIL; head = cdr(head), n++)
    {
        lispobj item = car(head);
        symbol_name = car(item);
        datap = (NIL!=(cdr(item)));
        namechars = (void*)(intptr_t)FOTHERPTR(symbol_name,vector).data;
        result = os_dlsym_default(namechars);
        odxprint(runtime_link, "linking %s => %p", namechars, result);

        if (link_target == validated_end) {
            validated_end += os_vm_page_size;
#ifdef LISP_FEATURE_WIN32
            os_validate_recommit(link_target,os_vm_page_size);
#endif
        }
        if (result) {
            if (datap)
                arch_write_linkage_table_ref(link_target,result);
            else
                arch_write_linkage_table_jmp(link_target,result);
        } else {
            m++;
            if (strict)
                fprintf(stderr,
                        "undefined foreign symbol in cold init: %s\n",
                        namechars);
        }

        link_target = (void*)(((uintptr_t)link_target)+LINKAGE_TABLE_ENTRY_SIZE);
    }
    odxprint(runtime_link, "%d total symbols linked, %d undefined",
             n, m);
    if (strict && m)
        /* We could proceed, but rather than run into improperly
         * displayed internal errors, let's make ourselves heard right
         * here and now. */
        lose("Undefined aliens in cold init.");
}
コード例 #3
0
ファイル: monitor.c プロジェクト: hanshuebner/sbcl
static void
print_context_cmd(char **ptr)
{
    int free_ici;
    struct thread *thread=arch_os_get_current_thread();

    free_ici = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread));

    if (more_p(ptr)) {
        int index;

        index = parse_number(ptr);

        if ((index >= 0) && (index < free_ici)) {
            printf("There are %d interrupt contexts.\n", free_ici);
            printf("printing context %d\n", index);
            print_context(thread->interrupt_contexts[index]);
        } else {
            printf("There aren't that many/few contexts.\n");
            printf("There are %d interrupt contexts.\n", free_ici);
        }
    } else {
        if (free_ici == 0)
            printf("There are no interrupt contexts!\n");
        else {
            printf("There are %d interrupt contexts.\n", free_ici);
            printf("printing context %d\n", free_ici - 1);
            print_context(thread->interrupt_contexts[free_ici - 1]);
        }
    }
}
コード例 #4
0
ファイル: arm-arch.c プロジェクト: Ferada/sbcl
boolean arch_pseudo_atomic_atomic(os_context_t *context)
{
    /* FIXME: this foreign_function_call_active test is dubious at
     * best. If a foreign call is made in a pseudo atomic section
     * (?) or more likely a pseudo atomic section is in a foreign
     * call then an interrupt is executed immediately. Maybe it
     * has to do with C code not maintaining pseudo atomic
     * properly. MG - 2005-08-10
     *
     * The foreign_function_call_active used to live at each call-site
     * to arch_pseudo_atomic_atomic, but this seems clearer.
     * --NS 2007-05-15 */
#ifdef LISP_FEATURE_GENCGC
    return SymbolValue(PSEUDO_ATOMIC_ATOMIC, 0) != NIL;
#else
    return (!foreign_function_call_active)
        && (NIL != SymbolValue(PSEUDO_ATOMIC_ATOMIC,0));
#endif
}
コード例 #5
0
ファイル: monitor.c プロジェクト: hanshuebner/sbcl
static void
regs_cmd(char **ptr)
{
    struct thread *thread=arch_os_get_current_thread();

    printf("CSP\t=\t%p   ", access_control_stack_pointer(thread));
#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
    printf("CFP\t=\t%p   ", access_control_frame_pointer(thread));
#endif

#ifdef reg_BSP
    printf("BSP\t=\t%p\n", get_binding_stack_pointer(thread));
#else
    /* printf("BSP\t=\t0x%08lx\n",
           (unsigned long)SymbolValue(BINDING_STACK_POINTER)); */
    printf("\n");
#endif

#ifdef LISP_FEATURE_GENCGC
    /* printf("DYNAMIC\t=\t0x%08lx\n", DYNAMIC_SPACE_START); */
#else
    printf("STATIC\t=\t%p   ",
           SymbolValue(STATIC_SPACE_FREE_POINTER, thread));
    printf("RDONLY\t=\t0x%08lx   ",
           (unsigned long)SymbolValue(READ_ONLY_SPACE_FREE_POINTER, thread));
    printf("DYNAMIC\t=\t0x%08lx\n", (unsigned long)current_dynamic_space);
#endif

#ifdef reg_ALLOC
    printf("ALLOC\t=\t0x%08lx\n", (unsigned long)dynamic_space_free_pointer);
#else
    printf("ALLOC\t=\t0x%08lx\n",
           (unsigned long)SymbolValue(ALLOCATION_POINTER, thread));
#endif

#ifndef LISP_FEATURE_GENCGC
    printf("TRIGGER\t=\t0x%08lx\n", (unsigned long)current_auto_gc_trigger);
#endif
}
コード例 #6
0
ファイル: os-common.c プロジェクト: krwq/sbcl
void os_link_runtime()
{
#ifdef LISP_FEATURE_SB_DYNAMIC_CORE
    char *link_target = (char*)(intptr_t)LINKAGE_TABLE_SPACE_START;
    void *validated_end = link_target;
    lispobj symbol_name;
    char *namechars;
    boolean datap;
    void* result;
    int j;

    if (lisp_linkage_table_n_prelinked)
        return; // Linkage was already performed by coreparse

    struct vector* symbols = VECTOR(SymbolValue(REQUIRED_FOREIGN_SYMBOLS,0));
    lisp_linkage_table_n_prelinked = fixnum_value(symbols->length);
    for (j = 0 ; j < lisp_linkage_table_n_prelinked ; ++j)
    {
        lispobj item = symbols->data[j];
        datap = listp(item);
        symbol_name = datap ? CONS(item)->car : item;
        namechars = (void*)(intptr_t)(VECTOR(symbol_name)->data);
        result = os_dlsym_default(namechars);

        if (link_target == validated_end) {
            validated_end = (char*)validated_end + os_vm_page_size;
#ifdef LISP_FEATURE_WIN32
            os_validate_recommit(link_target,os_vm_page_size);
#endif
        }
        if (result) {
            arch_write_linkage_table_entry(link_target, result, datap);
        } else { // startup might or might not work. ymmv
            printf("Missing required foreign symbol '%s'\n", namechars);
        }

        link_target += LINKAGE_TABLE_ENTRY_SIZE;
    }
#endif /* LISP_FEATURE_SB_DYNAMIC_CORE */
#ifdef LISP_FEATURE_X86_64
    SetSymbolValue(CPUID_FN1_ECX, (lispobj)make_fixnum(cpuid_fn1_ecx), 0);
#endif
}
コード例 #7
0
ファイル: ipcLisp.c プロジェクト: StoneAerospace/ipc
char *x_ipcRefNameLisp(X_IPC_REF_PTR ref, int32 length)
{
  BCOPY(ref->name, (char *)Vecdata(SymbolValue(lisp_value(0))), length);
  
  return (char *)SymbolValue(lisp_value(0));
}
コード例 #8
0
ファイル: save.c プロジェクト: bsmr-common-lisp/sbcl
boolean
save_to_filehandle(FILE *file, char *filename, lispobj init_function,
                   boolean make_executable,
                   boolean save_runtime_options,
                   int core_compression_level)
{
    struct thread *th;
    os_vm_offset_t core_start_pos;

#ifdef LISP_FEATURE_X86_64
    untune_asm_routines_for_microarch();
#endif

    /* Smash the enclosing state. (Once we do this, there's no good
     * way to go back, which is a sufficient reason that this ends up
     * being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
    printf("[undoing binding stack and other enclosing state... ");
    fflush(stdout);
    for_each_thread(th) {       /* XXX really? */
        unbind_to_here((lispobj *)th->binding_stack_start,th);
        SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
        SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
    }
    printf("done]\n");
    fflush(stdout);

    /* (Now we can actually start copying ourselves into the output file.) */

    printf("[saving current Lisp image into %s:\n", filename);
    fflush(stdout);

    core_start_pos = ftell(file);
    write_lispobj(CORE_MAGIC, file);

    write_lispobj(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
    write_lispobj(/* (We're writing the word count of the entry here, and the 2
          * term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
          * word and one word where we store the count itself.) */
         2 + strlen((const char *)build_id),
         file);
    {
        unsigned char *p;
        for (p = (unsigned char *)build_id; *p; ++p)
            write_lispobj(*p, file);
    }

    write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
    write_lispobj(/* (word count = N spaces described by 5 words each, plus the
          * entry type code, plus this count itself) */
         (5*N_SPACES_TO_SAVE)+2, file);
    output_space(file,
                 READ_ONLY_CORE_SPACE_ID,
                 (lispobj *)READ_ONLY_SPACE_START,
                 (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
                 core_start_pos,
                 core_compression_level);
    output_space(file,
                 STATIC_CORE_SPACE_ID,
                 (lispobj *)STATIC_SPACE_START,
                 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
                 core_start_pos,
                 core_compression_level);
#ifdef LISP_FEATURE_GENCGC
    /* Flush the current_region, updating the tables. */
    gc_alloc_update_all_page_tables(1);
    update_dynamic_space_free_pointer();
#endif
#ifdef LISP_FEATURE_IMMOBILE_SPACE
    prepare_immobile_space_for_save();
    output_space(file,
                 IMMOBILE_FIXEDOBJ_CORE_SPACE_ID,
                 (lispobj *)IMMOBILE_SPACE_START,
                 (lispobj *)SymbolValue(IMMOBILE_FIXEDOBJ_FREE_POINTER,0),
                 core_start_pos,
                 core_compression_level);
    output_space(file,
                 IMMOBILE_VARYOBJ_CORE_SPACE_ID,
                 (lispobj *)IMMOBILE_VARYOBJ_SUBSPACE_START,
                 (lispobj *)SymbolValue(IMMOBILE_SPACE_FREE_POINTER,0),
                 core_start_pos,
                 core_compression_level);
#endif
#ifdef reg_ALLOC
#ifdef LISP_FEATURE_GENCGC
    output_space(file,
                 DYNAMIC_CORE_SPACE_ID,
                 (lispobj *)DYNAMIC_SPACE_START,
                 dynamic_space_free_pointer,
                 core_start_pos,
                 core_compression_level);
#else
    output_space(file,
                 DYNAMIC_CORE_SPACE_ID,
                 (lispobj *)current_dynamic_space,
                 dynamic_space_free_pointer,
                 core_start_pos,
                 core_compression_level);
#endif
#else
    output_space(file,
                 DYNAMIC_CORE_SPACE_ID,
                 (lispobj *)DYNAMIC_SPACE_START,
                 (lispobj *)SymbolValue(ALLOCATION_POINTER,0),
                 core_start_pos,
                 core_compression_level);
#endif

    write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
    write_lispobj(3, file);
    write_lispobj(init_function, file);

#ifdef LISP_FEATURE_GENCGC
    {
        size_t size = (last_free_page*sizeof(sword_t)+os_vm_page_size-1)
            &~(os_vm_page_size-1);
        uword_t *data = calloc(size, 1);
        if (data) {
            uword_t word;
            sword_t offset;
            page_index_t i;
            for (i = 0; i < last_free_page; i++) {
                /* Thanks to alignment requirements, the two low bits
                 * are always zero, so we can use them to store the
                 * allocation type -- region is always closed, so only
                 * the two low bits of allocation flags matter. */
                word = page_table[i].scan_start_offset;
                gc_assert((word & 0x03) == 0);
                data[i] = word | (0x03 & page_table[i].allocated);
            }
            write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
            write_lispobj(4, file);
            write_lispobj(size, file);
            offset = write_bytes(file, (char *)data, size, core_start_pos);
            write_lispobj(offset, file);
        }
    }
#endif

    write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);

    /* Write a trailing header, ignored when parsing the core normally.
     * This is used to locate the start of the core when the runtime is
     * prepended to it. */
    fseek(file, 0, SEEK_END);

    /* If NULL runtime options are passed to write_runtime_options,
     * command-line processing is performed as normal in the SBCL
     * executable. Otherwise, the saved runtime options are used and
     * all command-line arguments are available to Lisp in
     * SB-EXT:*POSIX-ARGV*. */
    write_runtime_options(file,
                          (save_runtime_options ? runtime_options : NULL));

    if (1 != fwrite(&core_start_pos, sizeof(os_vm_offset_t), 1, file)) {
        perror("Error writing core starting position to file");
        fclose(file);
    } else {
        write_lispobj(CORE_MAGIC, file);
        fclose(file);
    }

#ifndef LISP_FEATURE_WIN32
    if (make_executable)
        chmod (filename, 0755);
#endif

    printf("done]\n");
    exit(0);
}
コード例 #9
0
ファイル: x86-arch.c プロジェクト: Distrotech/cmucl
boolean
arch_pseudo_atomic_atomic(os_context_t * context)
{
    return SymbolValue(PSEUDO_ATOMIC_ATOMIC);
}
コード例 #10
0
ファイル: amd64-arch.c プロジェクト: Distrotech/cmucl
boolean
arch_pseudo_atomic_atomic(struct sigcontext *context)
{
    return SymbolValue(PSEUDO_ATOMIC_ATOMIC);
}
コード例 #11
0
ファイル: save.c プロジェクト: r3v01v3r/sbcl-tfb
boolean
save_to_filehandle(FILE *file, char *filename, lispobj init_function,
                   boolean make_executable,
                   boolean save_runtime_options)
{
    struct thread *th;
    os_vm_offset_t core_start_pos;

    /* Smash the enclosing state. (Once we do this, there's no good
     * way to go back, which is a sufficient reason that this ends up
     * being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
    printf("[undoing binding stack and other enclosing state... ");
    fflush(stdout);
    for_each_thread(th) {       /* XXX really? */
        unbind_to_here((lispobj *)th->binding_stack_start,th);
        SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
        SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
    }
    printf("done]\n");
    fflush(stdout);

    /* (Now we can actually start copying ourselves into the output file.) */

    printf("[saving current Lisp image into %s:\n", filename);
    fflush(stdout);

    core_start_pos = ftell(file);
    write_lispobj(CORE_MAGIC, file);

    write_lispobj(VERSION_CORE_ENTRY_TYPE_CODE, file);
    write_lispobj(3, file);
    write_lispobj(SBCL_CORE_VERSION_INTEGER, file);

    write_lispobj(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
    write_lispobj(/* (We're writing the word count of the entry here, and the 2
          * term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
          * word and one word where we store the count itself.) */
         2 + strlen((const char *)build_id),
         file);
    {
        unsigned char *p;
        for (p = (unsigned char *)build_id; *p; ++p)
            write_lispobj(*p, file);
    }

    write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
    write_lispobj(/* (word count = 3 spaces described by 5 words each, plus the
          * entry type code, plus this count itself) */
         (5*3)+2, file);
    output_space(file,
                 READ_ONLY_CORE_SPACE_ID,
                 (lispobj *)READ_ONLY_SPACE_START,
                 (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
                 core_start_pos);
    output_space(file,
                 STATIC_CORE_SPACE_ID,
                 (lispobj *)STATIC_SPACE_START,
                 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
                 core_start_pos);
#ifdef LISP_FEATURE_GENCGC
    /* Flush the current_region, updating the tables. */
    gc_alloc_update_all_page_tables();
    update_dynamic_space_free_pointer();
#endif
#ifdef reg_ALLOC
#ifdef LISP_FEATURE_GENCGC
    output_space(file,
                 DYNAMIC_CORE_SPACE_ID,
                 (lispobj *)DYNAMIC_SPACE_START,
                 dynamic_space_free_pointer,
                 core_start_pos);
#else
    output_space(file,
                 DYNAMIC_CORE_SPACE_ID,
                 (lispobj *)current_dynamic_space,
                 dynamic_space_free_pointer,
                 core_start_pos);
#endif
#else
    output_space(file,
                 DYNAMIC_CORE_SPACE_ID,
                 (lispobj *)DYNAMIC_SPACE_START,
                 (lispobj *)SymbolValue(ALLOCATION_POINTER,0),
                 core_start_pos);
#endif

    write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
    write_lispobj(3, file);
    write_lispobj(init_function, file);

#ifdef LISP_FEATURE_GENCGC
    {
        size_t size = (last_free_page*sizeof(long)+os_vm_page_size-1)
            &~(os_vm_page_size-1);
        unsigned long *data = calloc(size, 1);
        if (data) {
            long offset;
            int i;
            for (i = 0; i < last_free_page; i++) {
                data[i] = page_table[i].region_start_offset;
            }
            write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
            write_lispobj(4, file);
            write_lispobj(size, file);
            offset = write_bytes(file, (char *) data, size, core_start_pos);
            write_lispobj(offset, file);
        }
    }
#endif

#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX)
    if(n_lutexes > 0) {
        long offset;
        printf("writing %ld lutexes to the core...\n", n_lutexes);
        write_lispobj(LUTEX_TABLE_CORE_ENTRY_TYPE_CODE, file);
        /* word count of the entry */
        write_lispobj(4, file);
        /* indicate how many lutexes we saved */
        write_lispobj(n_lutexes, file);
        /* save the lutexes */
        offset = write_bytes(file, (char *) lutex_addresses,
                             n_lutexes * sizeof(*lutex_addresses),
                             core_start_pos);

        write_lispobj(offset, file);
    }
#endif

    write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);

    /* Write a trailing header, ignored when parsing the core normally.
     * This is used to locate the start of the core when the runtime is
     * prepended to it. */
    fseek(file, 0, SEEK_END);

    /* If NULL runtime options are passed to write_runtime_options,
     * command-line processing is performed as normal in the SBCL
     * executable. Otherwise, the saved runtime options are used and
     * all command-line arguments are available to Lisp in
     * SB-EXT:*POSIX-ARGV*. */
    write_runtime_options(file,
                          (save_runtime_options ? runtime_options : NULL));

    if (1 != fwrite(&core_start_pos, sizeof(os_vm_offset_t), 1, file)) {
        perror("Error writing core starting position to file");
        fclose(file);
    } else {
        write_lispobj(CORE_MAGIC, file);
        fclose(file);
    }

#ifndef LISP_FEATURE_WIN32
    if (make_executable)
        chmod (filename, 0755);
#endif

    printf("done]\n");
    exit(0);
}
コード例 #12
0
ファイル: save.c プロジェクト: primitivorm/cmucl
boolean
save_executable(char *filename, lispobj init_function)
{
    char *dir_name;

#if defined WANT_CGC
    volatile lispobj *func_ptr = &init_function;
    char sbuf[128];

    strcpy(sbuf, filename);
    filename = sbuf;
    /* Get rid of remnant stuff. This is a MUST so that
     * the memory manager can get started correctly when
     * we restart after this save. Purify is going to
     * maybe move the args so we need to consider them volatile,
     * especially if the gcc optimizer is working!!
     */
    purify(NIL, NIL);

    init_function = *func_ptr;
    /* Set dynamic space pointer to base value so we don't write out
     * MBs of just cleared heap.
     */
    if(SymbolValue(X86_CGC_ACTIVE_P) != NIL)
        SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_0_SPACE_START);
#endif
    dir_name = dirname(strdup(filename));

    printf("[Undoing binding stack... ");
    fflush(stdout);
    unbind_to_here((lispobj *)BINDING_STACK_START);
    SetSymbolValue(CURRENT_CATCH_BLOCK, 0);
    SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
    SetSymbolValue(EVAL_STACK_TOP, 0);
    printf("done]\n");
#if defined WANT_CGC && defined X86_CGC_ACTIVE_P
    SetSymbolValue(X86_CGC_ACTIVE_P, T);
#endif
    printf("[Saving current lisp image as executable into \"%s\":\n", filename);

    printf("\t[Writing core objects\n");
    fflush(stdout);
    write_space_object(dir_name, READ_ONLY_SPACE_ID, (os_vm_address_t)read_only_space,
                       (os_vm_address_t)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
    write_space_object(dir_name, STATIC_SPACE_ID, (os_vm_address_t)static_space,
                       (os_vm_address_t)SymbolValue(STATIC_SPACE_FREE_POINTER));
#ifdef GENCGC
    /* Flush the current_region updating the tables. */
#ifdef DEBUG_BAD_HEAP
    fprintf(stderr, "before ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
    dump_region(&boxed_region);
#endif
    gc_alloc_update_page_tables(0,&boxed_region);
    gc_alloc_update_page_tables(1,&unboxed_region);
#ifdef DEBUG_BAD_HEAP
    fprintf(stderr, "boxed_region after update\n");
    dump_region(&boxed_region);

    print_ptr((lispobj*) 0x2805a184);
#endif
#ifdef DEBUG_BAD_HEAP
    /*
     * For some reason x86 has a heap corruption problem.  I (rtoy)
     * have not been able to figure out how that occurs, but what is
     * happening is that when a core is loaded, there is some static
     * object pointing to an object that is on a free page.  In normal
     * usage, at startup there should be 4 objects in static space
     * pointing to a free page, because these are newly allocated
     * objects created by the C runtime.  However, there is an
     * additional object.
     *
     * I do not know what this object should be or how it got there,
     * but it will often cause CMUCL to fail to save a new core file.
     *
     * Disabling this call to update_dynamic_space_free_pointer is a
     * work around.  What is happening is that u_d_s_f_p is resetting
     * ALLOCATION_POINTER, but that weird object is in the current
     * region, but after resetting the pointer, that object isn't
     * saved to the core file.  By not resetting the pointer, the
     * object (or at least enough of it) gets saved in the core file
     * that we don't have problems when reloading.
     *
     * Note that on sparc and ppc, u_d_s_f_p doesn't actually do
     * anything because the call to reset ALLOCATION_POINTER is a nop
     * on sparc and ppc.  And sparc and ppc dont' have the heap
     * corruption issue.  That's not conclusive evidence, though.
     *
     * This needs more work and investigation.
     */
    update_dynamic_space_free_pointer();
#endif

#ifdef DEBUG_BAD_HEAP    
    fprintf(stderr, "after ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
#endif    
#endif

#ifdef reg_ALLOC
    write_space_object(dir_name, DYNAMIC_SPACE_ID, (os_vm_address_t)current_dynamic_space,
                       (os_vm_address_t)current_dynamic_space_free_pointer);
#else
    write_space_object(dir_name, DYNAMIC_SPACE_ID, (os_vm_address_t)current_dynamic_space,
                       (os_vm_address_t)SymbolValue(ALLOCATION_POINTER));
#endif

    printf("\tdone]\n");
    fflush(stdout);
    
    printf("Linking executable...\n");
    fflush(stdout);
    obj_run_linker(init_function, filename);
    printf("done.\n");
    exit(0);
}
コード例 #13
0
ファイル: elf.c プロジェクト: Distrotech/cmucl
int
obj_run_linker(long init_func_address, char *file)
{
    lispobj libstring = SymbolValue(CMUCL_LIB);     /* Get library: */
    struct vector *vec = (struct vector *)PTR(libstring);
    char *paths;
    char command[FILENAME_MAX + 1];
    char command_line[FILENAME_MAX + FILENAME_MAX + 10];
    char *strptr;
    struct stat st;
    int ret;
    extern int debug_lisp_search;
#ifndef UNICODE
    paths = strdup((char *)vec->data);
#else
    /*
     * What should we do here with 16-bit characters?  For now we just
     * take the low 8-bits.
     */
    paths = malloc(vec->length);
    {
        int k;
        unsigned short *data;
        data = (unsigned short*) vec->data;
        
        for (k = 0; k < vec->length; ++k) {
            paths[k] = data[k] & 0xff;
        }
    }
#endif
    strptr = strtok(paths, ":");

    if (debug_lisp_search) {
        printf("Searching for linker.sh script\n");
    }

    while(strptr != NULL) {
        
	sprintf(command, "%s/%s", strptr, LINKER_SCRIPT);

        if (debug_lisp_search) {
            printf("  %s\n", command);
        }
        
	if (stat(command, &st) == 0) {
	    free(paths);
	    printf("\t[%s: linking %s... \n", command, file);
	    fflush(stdout);
#if defined(__linux__) || defined(__FreeBSD__) || defined(SOLARIS) || defined(__NetBSD__)
            sprintf(command_line, "%s %s 0x%lx '%s' 0x%lx 0x%lx 0x%lx", command,
                    C_COMPILER, init_func_address, file,
                    (unsigned long) READ_ONLY_SPACE_START,
                    (unsigned long) STATIC_SPACE_START,
                    (unsigned long) DYNAMIC_0_SPACE_START);
#else
            extern int main();
	    sprintf(command_line, "%s %s 0x%lx 0x%lx %s", command, C_COMPILER,
                    init_func_address, (unsigned long) &main, file);
#endif
	    ret = system(command_line);
	    if(ret == -1) {
		perror("Can't run link script");
	    } else {
		printf("\tdone]\n");
		fflush(stdout);
	    }
	    return ret;
	}
	strptr = strtok(NULL, ":");
    }

    fprintf(stderr,
	    "Can't find %s script in CMUCL library directory list.\n", LINKER_SCRIPT);
    free(paths);
    return -1;
}