source: trunk/ccl/lisp-kernel/plsym.c @ 6

Last change on this file since 6 was 6, checked in by gb, 16 years ago

Initial revision

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