Commit | Line | Data |
---|---|---|
af988bbf | 1 | ;;; Guile VM debugging facilities |
ac99cb0c KN |
2 | |
3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ||
5 | ;; This program is free software; you can redistribute it and/or modify | |
6 | ;; it under the terms of the GNU General Public License as published by | |
7 | ;; the Free Software Foundation; either version 2, or (at your option) | |
8 | ;; any later version. | |
9 | ;; | |
10 | ;; This program is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;; GNU General Public License for more details. | |
14 | ;; | |
15 | ;; You should have received a copy of the GNU General Public License | |
16 | ;; along with this program; see the file COPYING. If not, write to | |
17 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
18 | ;; Boston, MA 02111-1307, USA. | |
19 | ||
20 | ;;; Code: | |
21 | ||
af988bbf | 22 | (define-module (system vm debug) |
1a1a10d3 AW |
23 | #:use-syntax (system base syntax) |
24 | #:use-module (system vm vm) | |
25 | #:use-module (system vm frame) | |
26 | #:use-module (ice-9 format) | |
27 | #:export (vm-debugger vm-backtrace)) | |
af988bbf KN |
28 | |
29 | \f | |
30 | ;;; | |
31 | ;;; Debugger | |
32 | ;;; | |
33 | ||
34 | (define-record (<debugger> vm chain index)) | |
35 | ||
36 | (define (vm-debugger vm) | |
37 | (let ((chain (vm-last-frame-chain vm))) | |
38 | (if (null? chain) | |
39 | (display "Nothing to debug\n") | |
849cefac | 40 | (debugger-repl (make-debugger |
1a1a10d3 | 41 | #:vm vm #:chain chain #:index (length chain)))))) |
af988bbf KN |
42 | |
43 | (define (debugger-repl db) | |
44 | (let loop () | |
45 | (display "debug> ") | |
46 | (let ((cmd (read))) | |
47 | (case cmd | |
61dc81d9 | 48 | ((bt) (vm-backtrace (debugger-vm db))) |
af988bbf | 49 | ((stack) |
61dc81d9 | 50 | (write (vm-fetch-stack (debugger-vm db))) |
af988bbf KN |
51 | (newline)) |
52 | (else | |
53 | (format #t "Unknown command: ~A" cmd)))))) | |
54 | ||
55 | \f | |
56 | ;;; | |
57 | ;;; Backtrace | |
58 | ;;; | |
ac99cb0c KN |
59 | |
60 | (define (vm-backtrace vm) | |
d0168f3d | 61 | (print-frame-chain-as-backtrace |
e15f4774 | 62 | (reverse (vm-last-frame-chain vm)))) |