source: trunk/source/lib/backtrace-lds.lisp @ 12463

Last change on this file since 12463 was 12463, checked in by gz, 10 years ago

Some changes in support of Slime:

Implement CCL:COMPUTE-APPLICABLE-METHODS-USING-CLASSES

Add a :stream-args argument to CCL:ACCEPT-CONNECTION, for one-time initargs for the stream being created. E.g. (accept-connection listener :stream-args `(:external-format ,external-format-for-this-connection-only))

Add CCL:TEMP-PATHNAME

Bind new var CCL:*TOP-ERROR-FRAME* to the error frame in break loops, to make it available to debugger/break hooks.

Add CCL:*SELECT-INTERACTIVE-PROCESS-HOOK* and call it to select the process to use for handling SIGINT.

Add CCL:*MERGE-COMPILER-WARNINGS* to control whether warnings with the same format string and args but different source locations should be merged.

Export CCL:COMPILER-WARNING, CCL:STYLE-WARNING, CCL:COMPILER-WARNING-FUNCTION-NAME and CCL:COMPILER-WARNING-SOURCE-NOTE.

Create a CCL:COMPILER-WARNING-SOURCE-NOTE even if not otherwise saving source locations, just using the fasl file and toplevel stream position, but taking into account compile-file-original-truename and compiler-file-original-buffer-offset. Get rid of stream-position and file-name slots in compiler warnings.

Export CCL:REPORT-COMPILER-WARNING, and make it accept a :SHORT keyword arg to skip the textual representation of the warning location.

Export CCL:NAME-OF, and make it return the fully qualified name for methods, return object for eql-specializer

Make CCL:FIND-DEFINITION-SOURCES handle xref-entries.

Export CCL:SETF-FUNCTION-SPEC-NAME, make it explicitly ignore the long-form setf method case.

Export the basic inspector API from the inspector package.

Export EQL-SPECIALIZER and SLOT-DEFINITION-DOCUMENTATION from OPENMCL-MOP

Refactor things a bit in backtrace code, define and export an API for examining backtraces:

CCL:MAP-CALL-FRAMES
CCL:FRAME-FUNCTION
CCL:FRAME-SUPPLIED-ARGUMENTS
CCL:FRAME-NAMED-VARIABLES

other misc new exports:

CCL:DEFINITION-TYPE
CCL;CALLER-FUNCTIONS
CCL:SLOT-DEFINITION-DOCUMENTATION
CCL:*SAVE-ARGLIST-INFO*
CCL:NATIVE-TRANSLATED-NAMESTRING
CCL:NATIVE-TO-PATHNAME
CCL:HASH-TABLE-WEAK-P
CCL;PROCESS-SERIAL-NUMBER
CCL:PROCESS-EXHAUSTED-P
CCL:APPLY-IN-FRAME

Other misc tweaks:

Make cbreak-loop use the break message when given a uselessly empty condition.

Use setf-function-name-p more consistently

Make find-applicable-methods handle eql specializers better.

Try to more consistently recognize lists of the form (:method ...) as method names.

Add xref-entry-full-name (which wasn't needed in the end)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.0 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL 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;;; backtrace-lds.lisp
18;;; low-level support for stack-backtrace dialog (Lisp Development System)
19
20(in-package "CCL")
21
22
23(defparameter *saved-register-count*
24  #+x8632-target 0
25  #+x8664-target 4
26  #+ppc-target 8)
27
28(defparameter *saved-register-names*
29  #+x8632-target nil
30  #+x8664-target #(save3 save2 save1 save0)
31  #+ppc-target #(save7 save6 save5 save4 save3 save2 save1 save0))
32
33(defun frame-function (frame context)
34  "Returns the function using the frame, and pc offset within the function, if known"
35  (declare (ignore context))
36  (cfp-lfun (require-type frame 'integer)))
37
38(defun frame-supplied-arguments (frame context &key (unknown-marker (%unbound-marker)))
39  "Return a list of supplied arguments to the call which opened this frame, as best we can reconstruct it"
40  (multiple-value-bind (lfun pc) (cfp-lfun frame)
41    (multiple-value-bind (args valid) (supplied-argument-list context frame lfun pc)
42      (if (not valid)
43        unknown-marker
44        (if (eq unknown-marker (%unbound-marker))
45          args
46          (substitute unknown-marker (%unbound-marker) args))))))
47
48(defun frame-named-variables (frame context &key (unknown-marker (%unbound-marker)))
49  "Returns an alist of (NAME . VALUE) of all named variables in this frame."
50  (multiple-value-bind (lfun pc) (cfp-lfun frame)
51    (multiple-value-bind (args locals) (arguments-and-locals context frame lfun pc unknown-marker)
52      (if (eq unknown-marker (%unbound-marker))
53        (append args locals)
54        (substitute unknown-marker (%unbound-marker) (append args locals))))))
55
56
57(defun frame-arguments-and-locals (frame context &key unknown-marker)
58  "Return two values, the arguments and the locals, known for this frame, as alists of (name . value)"
59  (multiple-value-bind (lfun pc) (cfp-lfun frame)
60    (arguments-and-locals context frame lfun pc unknown-marker)))
61
62;;; Returns three values: (ARG-VALUES TYPES NAMES), solely for the benefit
63;;; of the FRAME-ARGUMENTS function in SLIME's swank-openmcl.lisp.
64;;; ARG-VALUES is a list of the values of the args supplied to the function
65;;; TYPES is a list of (for bad historical reasons) strings .describing
66;;;   whether they're "required", "optional", etc.  SLIME only really
67;;;   cares about whether this is equal to "keyword" or not.
68;;; NAMES is a list of symbols which name the args.
69;; 7/13/2009: This is now deprecated.  Use frame-supplied-arguments.
70(defun frame-supplied-args (frame lfun pc child context)
71  (declare (ignore child))
72  (if (null pc)
73    (values nil nil nil)
74    (if (<= pc target::arg-check-trap-pc-limit)
75      (values (arg-check-call-arguments frame lfun) nil nil)
76      (multiple-value-bind (arglist valid) (arglist-from-map lfun)
77        (if (not valid)
78          (values nil nil nil)
79          (let* ((args (arguments-and-locals context frame lfun pc))
80                 (state :required))
81            (collect ((arg-values)
82                      (types)
83                      (names))
84              (dolist (arg arglist)
85                (if (or (member arg lambda-list-keywords)
86                        (eq arg '&lexpr))
87                  (setq state arg)
88                  (let* ((pair (pop args)))
89                    (case state
90                      (&lexpr
91                         (with-list-from-lexpr (rest (cdr pair))
92                           (dolist (r rest) (arg-values r) (names nil) (types nil)))
93                         (return))
94                      (&rest
95                         (dolist (r (cdr pair)) (arg-values r) (names nil) (types nil))
96                         (return))
97                      (&key
98                         (arg-values arg)
99                         (names nil)
100                         (types nil)))
101                    (let* ((value (cdr pair)))
102                      (if (eq value (%unbound-marker))
103                        (return))
104                      (names (car pair))
105                      (arg-values value)
106                      (types nil)))))
107              (values (arg-values) (types) (names)))))))))
108
109
110#|
111(setq *save-local-symbols* t)
112
113(defun test (flip flop &optional bar)
114  (let ((another-one t)
115        (bar 'quux))
116    (break)))
117
118(test '(a b c d) #\a)
119
120(defun closure-test (flim flam)
121  (labels ((inner (x)
122              (let ((ret (list x flam)))
123                (break))))
124    (inner flim)
125    (break)))
126
127(closure-test '(a b c) 'quux)
128
129(defun set-test (a b)
130  (break)
131  (+ a b))
132
133(set-test 1 'a)
134
135||#
136
137
138(provide 'backtrace-lds)
139
140; End of backtrace-lds.lisp
Note: See TracBrowser for help on using the repository browser.