source: release/1.7/source/lisp-kernel/plsym.c @ 15267

Last change on this file since 15267 was 13496, checked in by gb, 9 years ago

find_symbol(): look for symbols in managed_static areas, too.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.3 KB
Line 
1/*
2   Copyright (C) 2009 Clozure Associates
3   Copyright (C) 1994-2001 Digitool, Inc
4   This file is part of Clozure CL. 
5
6   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7   License , known as the LLGPL and distributed with Clozure CL as the
8   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9   which is distributed with Clozure CL as the file "LGPL".  Where these
10   conflict, the preamble takes precedence. 
11
12   Clozure CL is referenced in the preamble as the "LIBRARY."
13
14   The LLGPL is also available online at
15   http://opensource.franz.com/preamble.html
16*/
17
18#include "lispdcmd.h"
19
20void
21describe_symbol(LispObj sym)
22{
23  lispsymbol *rawsym = (lispsymbol *)ptr_from_lispobj(untag(sym));
24  LispObj function = rawsym->fcell;
25#ifdef fulltag_symbol
26  sym += (fulltag_symbol-fulltag_misc);
27#endif
28  Dprintf("Symbol %s at #x%llX", print_lisp_object(sym), (u64_t) sym);
29  Dprintf("  value    : %s", print_lisp_object(rawsym->vcell));
30  if (function != nrs_UDF.vcell) {
31    Dprintf("  function : %s", print_lisp_object(function));
32  }
33}
34 
35int
36compare_lisp_string_to_c_string(lisp_char_code *lisp_string,
37                                char *c_string,
38                                natural n)
39{
40  natural i;
41  for (i = 0; i < n; i++) {
42    if (lisp_string[i] != (lisp_char_code)(c_string[i])) {
43      return 1;
44    }
45  }
46  return 0;
47}
48
49/*
50  Walk the heap until we find a symbol
51  whose pname matches "name".  Return the
52  tagged symbol or NULL.
53*/
54
55LispObj
56find_symbol_in_range(LispObj *start, LispObj *end, char *name)
57{
58  LispObj header, tag;
59  int n = strlen(name);
60  char *s = name;
61  lisp_char_code *p;
62  while (start < end) {
63    header = *start;
64    tag = fulltag_of(header);
65    if (header_subtag(header) == subtag_symbol) {
66      LispObj
67        pname = deref(ptr_to_lispobj(start), 1),
68        pname_header = header_of(pname);
69      if ((header_subtag(pname_header) == subtag_simple_base_string) &&
70          (header_element_count(pname_header) == n)) {
71        p = (lisp_char_code *) ptr_from_lispobj(pname + misc_data_offset);
72        if (compare_lisp_string_to_c_string(p, s, n) == 0) {
73          return (ptr_to_lispobj(start))+fulltag_misc;
74        }
75      }
76    }
77    if (nodeheader_tag_p(tag)) {
78      start += (~1 & (2 + header_element_count(header)));
79    } else if (immheader_tag_p(tag)) {
80      start = (LispObj *) skip_over_ivector((natural)start, header);
81    } else {
82      start += 2;
83    }
84  }
85  return (LispObj)NULL;
86}
87
88LispObj
89find_symbol(char *name)
90{
91  area *a =  ((area *) (ptr_from_lispobj(lisp_global(ALL_AREAS))))->succ;
92  area_code code;
93  LispObj sym = 0;
94
95  while ((code = a->code) != AREA_VOID) {
96    if ((code == AREA_STATIC) ||
97        (code == AREA_DYNAMIC) ||
98        (code == AREA_MANAGED_STATIC)) {
99      sym = find_symbol_in_range((LispObj *)(a->low), (LispObj *)(a->active), name);
100      if (sym) {
101        break;
102      }
103    }
104    a = a->succ;
105  }
106  return sym;
107}
108
109   
110void 
111plsym(ExceptionInformation *xp, char *pname) 
112{
113  natural address = 0;
114
115  address = find_symbol(pname);
116  if (address == 0) {
117    Dprintf("Can't find symbol.");
118    return;
119  }
120 
121  if ((fulltag_of(address) == fulltag_misc) &&
122      (header_subtag(header_of(address)) == subtag_symbol)){
123    describe_symbol(address);
124  } else {
125    fprintf(dbgout, "Not a symbol.\n");
126  }
127  return;
128}
129
Note: See TracBrowser for help on using the repository browser.