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

Last change on this file since 10114 was 10114, checked in by rme, 11 years ago

Conditionalize for x8632.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.3 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
34;;; Returns three values: (ARG-VALUES TYPES NAMES), solely for the benefit
35;;; of the FRAME-ARGUMENTS function in SLIME's swank-openmcl.lisp.
36;;; ARG-VALUES is a list of the values of the args supplied to the function
37;;; TYPES is a list of (for bad historical reasons) strings .describing
38;;;   whether they're "required", "optional", etc.  SLIME only really
39;;;   cares about whether this is equal to "keyword" or not.
40;;; NAMES is a list of symbols which name the args.
41(defun frame-supplied-args (frame lfun pc child context)
42  (declare (ignore child))
43  (if (null pc)
44    (values nil nil nil)
45    (if (<= pc target::arg-check-trap-pc-limit)
46      (values (arg-check-call-arguments frame lfun) nil nil)
47      (let* ((arglist (arglist-from-map lfun))
48             (args (arguments-and-locals context frame lfun pc))
49             (state :required))
50        (collect ((arg-values)
51                  (types)
52                  (names))
53          (dolist (arg arglist)
54            (if (or (member arg lambda-list-keywords)
55                    (eq arg '&lexpr))
56              (setq state arg)
57              (let* ((pair (pop args)))
58                (case state
59                  (&lexpr
60                   (with-list-from-lexpr (rest (cdr pair))
61                     (dolist (r rest) (arg-values r) (names nil) (types nil)))
62                   (return))
63                  (&rest
64                   (dolist (r (cdr pair)) (arg-values r) (names nil) (types nil))
65                   (return))
66                  (&key
67                   (arg-values arg)
68                   (names nil)
69                   (types nil)))
70                (let* ((value (cdr pair)))
71                  (if (eq value (%unbound-marker))
72                    (return))
73                  (names (car pair))
74                  (arg-values value)
75                  (types nil)))))
76          (values (arg-values) (types) (names)))))))
77
78
79#|
80(setq *save-local-symbols* t)
81
82(defun test (flip flop &optional bar)
83  (let ((another-one t)
84        (bar 'quux))
85    (break)))
86
87(test '(a b c d) #\a)
88
89(defun closure-test (flim flam)
90  (labels ((inner (x)
91              (let ((ret (list x flam)))
92                (break))))
93    (inner flim)
94    (break)))
95
96(closure-test '(a b c) 'quux)
97
98(defun set-test (a b)
99  (break)
100  (+ a b))
101
102(set-test 1 'a)
103
104||#
105
106
107(provide 'backtrace-lds)
108
109; End of backtrace-lds.lisp
Note: See TracBrowser for help on using the repository browser.