source: trunk/source/lisp-kernel/plsym.c @ 13067

Last change on this file since 13067 was 13067, checked in by rme, 10 years ago

Update copyright notices.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 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      sym = find_symbol_in_range((LispObj *)(a->low), (LispObj *)(a->active), name);
99      if (sym) {
100        break;
101      }
102    }
103    a = a->succ;
104  }
105  return sym;
106}
107
108   
109void 
110plsym(ExceptionInformation *xp, char *pname) 
111{
112  natural address = 0;
113
114  address = find_symbol(pname);
115  if (address == 0) {
116    Dprintf("Can't find symbol.");
117    return;
118  }
119 
120  if ((fulltag_of(address) == fulltag_misc) &&
121      (header_subtag(header_of(address)) == subtag_symbol)){
122    describe_symbol(address);
123  } else {
124    fprintf(dbgout, "Not a symbol.\n");
125  }
126  return;
127}
128
Note: See TracBrowser for help on using the repository browser.