struct lispobj *env_var_lookup(struct lispobj *var, struct lispobj *env) { struct lispobj *frame, *cell; char error[64]; while(env != NULL) { frame = ENV_FIRST(env); while(frame != NULL) { cell = CAR(frame); if(CAR(cell) == var) { /* Return whole cell, e.g. (foo . 1). */ return cell; } frame = CDR(frame); } env = ENV_REST(env); } snprintf(error, 64, "Unbound variable: %s.\n", SYMBOL_VALUE(var)); return NEW_ERROR(error); }
static struct mdebug_extra_func_info * find_proc_desc (CORE_ADDR pc) { struct block *b = block_for_pc (pc); struct mdebug_extra_func_info *proc_desc = NULL; struct symbol *sym = NULL; if (b) { CORE_ADDR startaddr; find_pc_partial_function (pc, NULL, &startaddr, NULL); if (startaddr > BLOCK_START (b)) /* This is the "pathological" case referred to in a comment in print_frame_info. It might be better to move this check into symbol reading. */ sym = NULL; else sym = lookup_symbol (MDEBUG_EFI_SYMBOL_NAME, b, LABEL_DOMAIN, 0, NULL); } if (sym) { proc_desc = (struct mdebug_extra_func_info *) SYMBOL_VALUE (sym); /* If we never found a PDR for this function in symbol reading, then examine prologues to find the information. */ if (proc_desc->pdr.framereg == -1) proc_desc = NULL; } return proc_desc; }
void env_debug(void) { struct lispobj *tmp_env = environment; while(tmp_env != NULL) { struct lispobj *frame = ENV_FIRST(tmp_env); printf(" ("); while(frame != NULL) { struct lispobj *cell = CAR(frame); printf(" [%s %d; 0x%x %d] ", SYMBOL_VALUE(CAR(cell)), OBJ_REFS(CAR(cell)), CDR(cell), CDR(cell) != NULL ? OBJ_REFS(CDR(cell)) : -1); frame = CDR(frame); } printf(") "); tmp_env = CDR(tmp_env); } printf("\n"); }
struct lispobj *env_var_define(struct lispobj *var, struct lispobj *val, struct lispobj *env) { struct lispobj *frame, *pair, *cell, *lookup; /* Checking on variable existence. */ lookup = env_var_lookup(var, env); /* If variable exists return error. */ if(OBJ_TYPE(lookup) != ERROR) { char error[64]; snprintf(error, 64, "Variable already exists: %s.\n", SYMBOL_VALUE(var)); return NEW_ERROR(error); } /* Remove not necessary object. */ heap_release(lookup); /* Get top frame from environment. */ frame = ENV_FIRST(env); /* Creating cell for new variable. */ cell = NEW_CONS(var, val); /* Appending new cell into the frame. */ pair = NEW_CONS(cell, frame); frame = heap_grab(pair); /* Appending the frame into the environment. */ CAR(env) = frame; return val; }
struct lispobj *symbol_table_lookup(char *symbol) { struct lispobj *tmp = symbol_table; while(tmp != NULL) { if(!strcmp(SYMBOL_VALUE(CAR(tmp)), symbol)) { return CAR(tmp); } tmp = CDR(tmp); } return NULL; }
void symbol_table_debug(void) { struct lispobj *tmp_symt; tmp_symt = symbol_table; printf("__DEBUG_SYMT__: symbol table:\n"); while(tmp_symt != NULL) { printf("[%s %d]\n", SYMBOL_VALUE(CAR(tmp_symt)), OBJ_REFS(CAR(tmp_symt))); tmp_symt = CDR(tmp_symt); } printf("\n"); return; }
//#ifdef __DEBUG_HEAP__ void heap_debug_object(struct lispobj *obj) { if(obj == NULL) { printf(" null pointer"); } else { printf(" [%p ", obj); if(OBJ_TYPE(obj) == SYMBOL) { printf("(symbol %s) ", SYMBOL_VALUE(obj)); } else if(OBJ_TYPE(obj) == NUMBER) { printf("(number %d) ", NUMBER_VALUE(obj)); } else if(OBJ_TYPE(obj) == STRING) { printf("(string %s) ", STRING_VALUE(obj)); } else { printf("(cons) "); } printf("%d] ", OBJ_REFS(obj)); } }
static struct mdebug_extra_func_info * find_proc_desc (CORE_ADDR pc) { struct block *b = block_for_pc (pc); struct mdebug_extra_func_info *proc_desc = NULL; struct symbol *sym = NULL; char *sh_name = NULL; if (b) { CORE_ADDR startaddr; find_pc_partial_function (pc, &sh_name, &startaddr, NULL); if (startaddr > BLOCK_START (b)) /* This is the "pathological" case referred to in a comment in print_frame_info. It might be better to move this check into symbol reading. */ sym = NULL; else sym = lookup_symbol (MDEBUG_EFI_SYMBOL_NAME, b, LABEL_DOMAIN, 0); } if (sym) { proc_desc = (struct mdebug_extra_func_info *) SYMBOL_VALUE (sym); /* Correct incorrect setjmp procedure descriptor from the library to make backtrace through setjmp work. */ if (proc_desc->pdr.pcreg == 0 && strcmp (sh_name, "setjmp") == 0) { proc_desc->pdr.pcreg = ALPHA_RA_REGNUM; proc_desc->pdr.regmask = 0x80000000; proc_desc->pdr.regoffset = -4; } /* If we never found a PDR for this function in symbol reading, then examine prologues to find the information. */ if (proc_desc->pdr.framereg == -1) proc_desc = NULL; } return proc_desc; }
void print(struct lispobj *obj) { #ifdef __DEBUG_PRINT__ printf("["); #endif /* __DEBUG_PRINT__ */ if(obj == NULL) { printf("NIL"); } else if(OBJ_TYPE(obj) == ERROR) { printf("Error: %s", ERROR_VALUE(obj)); } else if(OBJ_TYPE(obj) == SYMBOL) { printf("%s", SYMBOL_VALUE(obj)); } else if(OBJ_TYPE(obj) == NUMBER) { printf("%d", NUMBER_VALUE(obj)); } else if(OBJ_TYPE(obj) == STRING) { printf("\"%s\"", STRING_VALUE(obj)); } else { if(CAR(obj) == NEW_SYMBOL("PROC")) { printf("<procedure "); if(CADR(obj) != NEW_SYMBOL("NIL")) { print_list(CADR(obj)); } else { printf("()"); } printf(" %p>", CADDDR(obj)); } else if(CAR(obj) == NEW_SYMBOL("SUBR")) { printf("<primitive-procedure %p>", CADR(obj)); } else { print_list(obj); } } #ifdef __DEBUG_PRINT__ if(obj != NULL) { printf(" => %d]", OBJ_REFS(obj)); } else { printf(" => nil]"); } #endif /* __DEBUG_PRINT__ */ return; }
static void convert_one_symbol (struct compile_c_instance *context, struct symbol *sym, int is_global, int is_local) { gcc_type sym_type; const char *filename = symbol_symtab (sym)->filename; unsigned short line = SYMBOL_LINE (sym); error_symbol_once (context, sym); if (SYMBOL_CLASS (sym) == LOC_LABEL) sym_type = 0; else sym_type = convert_type (context, SYMBOL_TYPE (sym)); if (SYMBOL_DOMAIN (sym) == STRUCT_DOMAIN) { /* Binding a tag, so we don't need to build a decl. */ C_CTX (context)->c_ops->tagbind (C_CTX (context), SYMBOL_NATURAL_NAME (sym), sym_type, filename, line); } else { gcc_decl decl; enum gcc_c_symbol_kind kind; CORE_ADDR addr = 0; char *symbol_name = NULL; switch (SYMBOL_CLASS (sym)) { case LOC_TYPEDEF: kind = GCC_C_SYMBOL_TYPEDEF; break; case LOC_LABEL: kind = GCC_C_SYMBOL_LABEL; addr = SYMBOL_VALUE_ADDRESS (sym); break; case LOC_BLOCK: kind = GCC_C_SYMBOL_FUNCTION; addr = BLOCK_START (SYMBOL_BLOCK_VALUE (sym)); if (is_global && TYPE_GNU_IFUNC (SYMBOL_TYPE (sym))) addr = gnu_ifunc_resolve_addr (target_gdbarch (), addr); break; case LOC_CONST: if (TYPE_CODE (SYMBOL_TYPE (sym)) == TYPE_CODE_ENUM) { /* Already handled by convert_enum. */ return; } C_CTX (context)->c_ops->build_constant (C_CTX (context), sym_type, SYMBOL_NATURAL_NAME (sym), SYMBOL_VALUE (sym), filename, line); return; case LOC_CONST_BYTES: error (_("Unsupported LOC_CONST_BYTES for symbol \"%s\"."), SYMBOL_PRINT_NAME (sym)); case LOC_UNDEF: internal_error (__FILE__, __LINE__, _("LOC_UNDEF found for \"%s\"."), SYMBOL_PRINT_NAME (sym)); case LOC_COMMON_BLOCK: error (_("Fortran common block is unsupported for compilation " "evaluaton of symbol \"%s\"."), SYMBOL_PRINT_NAME (sym)); case LOC_OPTIMIZED_OUT: error (_("Symbol \"%s\" cannot be used for compilation evaluation " "as it is optimized out."), SYMBOL_PRINT_NAME (sym)); case LOC_COMPUTED: if (is_local) goto substitution; /* Probably TLS here. */ warning (_("Symbol \"%s\" is thread-local and currently can only " "be referenced from the current thread in " "compiled code."), SYMBOL_PRINT_NAME (sym)); /* FALLTHROUGH */ case LOC_UNRESOLVED: /* 'symbol_name' cannot be used here as that one is used only for local variables from compile_dwarf_expr_to_c. Global variables can be accessed by GCC only by their address, not by their name. */ { struct value *val; struct frame_info *frame = NULL; if (symbol_read_needs_frame (sym)) { frame = get_selected_frame (NULL); if (frame == NULL) error (_("Symbol \"%s\" cannot be used because " "there is no selected frame"), SYMBOL_PRINT_NAME (sym)); } val = read_var_value (sym, frame); if (VALUE_LVAL (val) != lval_memory) error (_("Symbol \"%s\" cannot be used for compilation " "evaluation as its address has not been found."), SYMBOL_PRINT_NAME (sym)); kind = GCC_C_SYMBOL_VARIABLE; addr = value_address (val); } break; case LOC_REGISTER: case LOC_ARG: case LOC_REF_ARG: case LOC_REGPARM_ADDR: case LOC_LOCAL: substitution: kind = GCC_C_SYMBOL_VARIABLE; symbol_name = symbol_substitution_name (sym); break; case LOC_STATIC: kind = GCC_C_SYMBOL_VARIABLE; addr = SYMBOL_VALUE_ADDRESS (sym); break; case LOC_FINAL_VALUE: default: gdb_assert_not_reached ("Unreachable case in convert_one_symbol."); } /* Don't emit local variable decls for a raw expression. */ if (context->base.scope != COMPILE_I_RAW_SCOPE || symbol_name == NULL) { decl = C_CTX (context)->c_ops->build_decl (C_CTX (context), SYMBOL_NATURAL_NAME (sym), kind, sym_type, symbol_name, addr, filename, line); C_CTX (context)->c_ops->bind (C_CTX (context), decl, is_global); } xfree (symbol_name); } }
void garbage_collect(long min_space) { char *p; object **gcp; object *op; long i, max, count; int old_interrupt; if (*will_gc_hook) (*will_gc_hook)(); old_interrupt = enable_interrupts(0); /* switch heap space */ gc_count++; /* printf("[GC]\n"); */ heap += heap_size; if (heap >= max_heap) heap = min_memory; heap_pointer = heap; heap_end = heap + heap_size; /* migrate objects */ count = gc_root_stack_pointer - gc_root_stack_begin; migrate_object(gc_root_stack_buffer); if (FORWARDED_P(gc_root_stack_buffer)) gc_root_stack_buffer = FORWARDED_POINTER(gc_root_stack_buffer); gc_root_stack_begin = (object **)BUFFER_DATA(gc_root_stack_buffer); gc_root_stack_end = gc_root_stack_begin + GC_ROOT_STACK_MAX; gc_root_stack_pointer = gc_root_stack_begin + count; gcp = gc_root_stack_begin; for (i=0; i<count; i++) migrate_object(*gcp[i]); for (op = sp; op < stack_top; op++) migrate_object(*op); /* eliminate forwarding pointers */ gcp = gc_root_stack_begin; for (i=0; i<count; i++) { object o = *gcp[i]; if (FORWARDED_P(o)) *gcp[i] = FORWARDED_POINTER(o); } for (op = sp; op < stack_top; op++) { object o = *op; if (FORWARDED_P(o)) *op = FORWARDED_POINTER(o); } p = heap; while (p < heap_pointer) { object *q, obj, o; obj = (object)p; switch (POINTER_TYPE(obj)) { case PAIR_TYPE: o = CAR(obj); if (FORWARDED_P(o)) CAR(obj) = FORWARDED_POINTER(o); o = CDR(obj); if (FORWARDED_P(o)) CDR(obj) = FORWARDED_POINTER(o); break; case WEAK_TYPE: if (FORWARDED_P(WEAK_VALUE(obj))) { WEAK_BOUND(obj) = 1; } else { WEAK_BOUND(obj) = 0; migrate_object(WEAK_VALUE(obj)); } o = WEAK_VALUE(obj); if (FORWARDED_P(o)) WEAK_VALUE(obj) = FORWARDED_POINTER(o); break; case SYMBOL_TYPE: o = SYMBOL_VALUE(obj); if (FORWARDED_P(o)) SYMBOL_VALUE(obj) = FORWARDED_POINTER(o); break; case VECTOR_TYPE: max = VECTOR_LENGTH(obj); q = VECTOR_ELEMENTS(obj); for (i=0; i<max; i++) { o = q[i]; if (FORWARDED_P(o)) q[i] = FORWARDED_POINTER(o); } o = VECTOR_TAG(obj); if (FORWARDED_P(o)) VECTOR_TAG(obj) = FORWARDED_POINTER(o); break; case PROCEDURE_TYPE: o = PROC_MODULE(obj); if (FORWARDED_P(o)) PROC_MODULE(obj) = FORWARDED_POINTER(o); break; case FRAME_TYPE: o = FRAME_PREVIOUS(obj); if (FORWARDED_P(o)) FRAME_PREVIOUS(obj) = FORWARDED_POINTER(o); o = FRAME_ENV(obj); if (FORWARDED_P(o)) FRAME_ENV(obj) = FORWARDED_POINTER(o); max = (POINTER_LENGTH(obj) - sizeof(struct frame_heap_structure))/sizeof(long); q = FRAME_ELEMENTS(obj); for (i=0; i<max; i++) { o = q[i]; if (FORWARDED_P(o)) q[i] = FORWARDED_POINTER(o); } break; case CLOSURE_TYPE: o = CLOSURE_PROC(obj); if (FORWARDED_P(o)) CLOSURE_PROC(obj) = FORWARDED_POINTER(o); o = CLOSURE_ENV(obj); if (FORWARDED_P(o)) CLOSURE_ENV(obj) = FORWARDED_POINTER(o); break; case CONTINUATION_TYPE: o = CONTINUATION_FRAME(obj); if (FORWARDED_P(o)) CONTINUATION_FRAME(obj) = FORWARDED_POINTER(o); max = CONTINUATION_STACKSIZE(obj); q = CONTINUATION_STACK(obj); for (i=0; i<max; i++) { o = q[i]; if (FORWARDED_P(o)) q[i] = FORWARDED_POINTER(o); } break; case SYMBOLTABLE_TYPE: o = SYMBOLTABLE_MAPPINGS(obj); if (FORWARDED_P(o)) SYMBOLTABLE_MAPPINGS(obj) = FORWARDED_POINTER(o); break; case PORT_TYPE: o = PORT_BUFFER(obj); if (FORWARDED_P(o)) PORT_BUFFER(obj) = FORWARDED_POINTER(o); break; default: fatal_error("Unknown pointer type: heap.c#garbage_collect(): %p\n", obj); return; } p += POINTER_LENGTH(obj); } /* finalization of ports */ close_stale_ports(); fix_runtime_pointers(); /* Finish up */ enable_interrupts(old_interrupt); i = heap_size - (heap_pointer - heap); if (i < min_space) fatal_error("out of heap space: %d\n", i); if (*did_gc_hook) (*did_gc_hook)(); }
static struct mdebug_extra_func_info * non_heuristic_proc_desc (CORE_ADDR pc, CORE_ADDR *addrptr) { CORE_ADDR startaddr; struct mdebug_extra_func_info *proc_desc; struct block *b = block_for_pc (pc); struct symbol *sym; struct obj_section *sec; struct mips_objfile_private *priv; find_pc_partial_function (pc, NULL, &startaddr, NULL); if (addrptr) *addrptr = startaddr; priv = NULL; sec = find_pc_section (pc); if (sec != NULL) { priv = (struct mips_objfile_private *) objfile_data (sec->objfile, mips_pdr_data); /* Search the ".pdr" section generated by GAS. This includes most of the information normally found in ECOFF PDRs. */ the_bfd = sec->objfile->obfd; if (priv == NULL && (the_bfd->format == bfd_object && bfd_get_flavour (the_bfd) == bfd_target_elf_flavour && elf_elfheader (the_bfd)->e_ident[EI_CLASS] == ELFCLASS64)) { /* Right now GAS only outputs the address as a four-byte sequence. This means that we should not bother with this method on 64-bit targets (until that is fixed). */ priv = obstack_alloc (&sec->objfile->objfile_obstack, sizeof (struct mips_objfile_private)); priv->size = 0; set_objfile_data (sec->objfile, mips_pdr_data, priv); } else if (priv == NULL) { asection *bfdsec; priv = obstack_alloc (&sec->objfile->objfile_obstack, sizeof (struct mips_objfile_private)); bfdsec = bfd_get_section_by_name (sec->objfile->obfd, ".pdr"); if (bfdsec != NULL) { priv->size = bfd_section_size (sec->objfile->obfd, bfdsec); priv->contents = obstack_alloc (&sec->objfile->objfile_obstack, priv->size); bfd_get_section_contents (sec->objfile->obfd, bfdsec, priv->contents, 0, priv->size); /* In general, the .pdr section is sorted. However, in the presence of multiple code sections (and other corner cases) it can become unsorted. Sort it so that we can use a faster binary search. */ qsort (priv->contents, priv->size / 32, 32, compare_pdr_entries); } else priv->size = 0; set_objfile_data (sec->objfile, mips_pdr_data, priv); } the_bfd = NULL; if (priv->size != 0) { int low, mid, high; char *ptr; CORE_ADDR pdr_pc; low = 0; high = priv->size / 32; /* We've found a .pdr section describing this objfile. We want to find the entry which describes this code address. The .pdr information is not very descriptive; we have only a function start address. We have to look for the closest entry, because the local symbol at the beginning of this function may have been stripped - so if we ask the symbol table for the start address we may get a preceding global function. */ /* First, find the last .pdr entry starting at or before PC. */ do { mid = (low + high) / 2; ptr = priv->contents + mid * 32; pdr_pc = bfd_get_signed_32 (sec->objfile->obfd, ptr); pdr_pc += ANOFFSET (sec->objfile->section_offsets, SECT_OFF_TEXT (sec->objfile)); if (pdr_pc > pc) high = mid; else low = mid + 1; } while (low != high); /* Both low and high point one past the PDR of interest. If both are zero, that means this PC is before any region covered by a PDR, i.e. pdr_pc for the first PDR entry is greater than PC. */ if (low > 0) { ptr = priv->contents + (low - 1) * 32; pdr_pc = bfd_get_signed_32 (sec->objfile->obfd, ptr); pdr_pc += ANOFFSET (sec->objfile->section_offsets, SECT_OFF_TEXT (sec->objfile)); } /* We don't have a range, so we have no way to know for sure whether we're in the correct PDR or a PDR for a preceding function and the current function was a stripped local symbol. But if the PDR's PC is at least as great as the best guess from the symbol table, assume that it does cover the right area; if a .pdr section is present at all then nearly every function will have an entry. The biggest exception will be the dynamic linker stubs; conveniently these are placed before .text instead of after. */ if (pc >= pdr_pc && pdr_pc >= startaddr) { struct symbol *sym = find_pc_function (pc); if (addrptr) *addrptr = pdr_pc; /* Fill in what we need of the proc_desc. */ proc_desc = (struct mdebug_extra_func_info *) obstack_alloc (&sec->objfile->objfile_obstack, sizeof (struct mdebug_extra_func_info)); PROC_LOW_ADDR (proc_desc) = pdr_pc; PROC_FRAME_OFFSET (proc_desc) = bfd_get_signed_32 (sec->objfile->obfd, ptr + 20); PROC_FRAME_REG (proc_desc) = bfd_get_32 (sec->objfile->obfd, ptr + 24); PROC_REG_MASK (proc_desc) = bfd_get_32 (sec->objfile->obfd, ptr + 4); PROC_FREG_MASK (proc_desc) = bfd_get_32 (sec->objfile->obfd, ptr + 12); PROC_REG_OFFSET (proc_desc) = bfd_get_signed_32 (sec->objfile->obfd, ptr + 8); PROC_FREG_OFFSET (proc_desc) = bfd_get_signed_32 (sec->objfile->obfd, ptr + 16); PROC_PC_REG (proc_desc) = bfd_get_32 (sec->objfile->obfd, ptr + 28); proc_desc->pdr.isym = (long) sym; return proc_desc; } } } if (b == NULL) return NULL; if (startaddr > BLOCK_START (b)) { /* This is the "pathological" case referred to in a comment in print_frame_info. It might be better to move this check into symbol reading. */ return NULL; } sym = lookup_symbol (MDEBUG_EFI_SYMBOL_NAME, b, LABEL_DOMAIN, 0); /* If we never found a PDR for this function in symbol reading, then examine prologues to find the information. */ if (sym) { proc_desc = (struct mdebug_extra_func_info *) SYMBOL_VALUE (sym); if (PROC_FRAME_REG (proc_desc) == -1) return NULL; else return proc_desc; } else return NULL; }