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

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

PPC64 changes (some of them rather suspect ...). 32-bit kernel may be a
little funky ...

  • 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 
33
34/*
35  Walk the heap until we find a symbol
36  whose pname matches "name".  Return the
37  tagged symbol or NULL.
38*/
39
40LispObj
41find_symbol_in_range(LispObj *start, LispObj *end, char *name)
42{
43  LispObj header;
44  int n = strlen(name);
45  char *s = name, *p;
46  while (start < end) {
47    header = *start;
48    if (header_subtag(header) == subtag_symbol) {
49      LispObj
50        pname = deref(start, 1),
51        pname_header = header_of(pname);
52      if ((header_subtag(pname_header) == subtag_simple_base_string) &&
53          (header_element_count(pname_header) == n)) {
54        p = (char *) (pname + misc_data_offset);
55        if (strncmp(p, s, n) == 0) {
56          return ((LispObj)start)+fulltag_misc;
57        }
58      }
59    }
60    if (fulltag_of(header) == fulltag_nodeheader) {
61      start += (~1 & (2 + header_element_count(header)));
62    } else if (fulltag_of(header) == fulltag_immheader) {
63      start = (LispObj *) skip_over_ivector((unsigned)start, header);
64    } else {
65      start += 2;
66    }
67  }
68  return (LispObj)NULL;
69}
70
71LispObj
72find_symbol(char *name)
73{
74  area *a =  ((area *) lisp_global(ALL_AREAS))->succ;
75  area_code code;
76  LispObj sym;
77
78  while ((code = a->code) != AREA_VOID) {
79    if ((code == AREA_STATIC) ||
80        (code == AREA_DYNAMIC)) {
81      sym = find_symbol_in_range((LispObj *)(a->low), (LispObj *)(a->active), name);
82      if (sym) {
83        break;
84      }
85    }
86    a = a->succ;
87  }
88  return sym;
89}
90
91   
92void 
93plsym(ExceptionInformation *xp, char *pname) 
94{
95  long  address = 0;
96
97  address = find_symbol(pname);
98  if (address == 0) {
99    Dprintf("Can't find symbol.");
100    return;
101  }
102 
103  if ((fulltag_of(address) == fulltag_misc) &&
104      (header_subtag(header_of(address)) == subtag_symbol)){
105    describe_symbol(address);
106  } else {
107    fprintf(stderr, "Not a symbol.\n");
108  }
109  return;
110}
111
Note: See TracBrowser for help on using the repository browser.