blob: 29235cd12c562433c9cb6f12d727a759b37b1c75 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
;;; swank-sbcl-exts.lisp --- Misc extensions for SBCL
;;
;; Authors: Tobias C. Rittweiler <tcr@freebits.de>
;;
;; License: Public Domain
;;
(in-package :swank)
(eval-when (:compile-toplevel :load-toplevel :execute)
(swank-require :swank-arglists))
;; We need to do this so users can place `slime-sbcl-exts' into their
;; ~/.emacs, and still use any implementation they want.
#+sbcl
(progn
;;; Display arglist of instructions.
;;;
(defmethod compute-enriched-decoded-arglist ((operator-form (eql 'sb-assem:inst))
argument-forms)
(flet ((decode-instruction-arglist (instr-name instr-arglist)
(let ((decoded-arglist (decode-arglist instr-arglist)))
;; The arglist of INST is (instruction ...INSTR-ARGLIST...).
(push 'sb-assem::instruction (arglist.required-args decoded-arglist))
(values decoded-arglist
(list instr-name)
t))))
(if (null argument-forms)
(call-next-method)
(destructuring-bind (instruction &rest args) argument-forms
(declare (ignore args))
(let* ((instr-name
(typecase instruction
(arglist-dummy
(string-upcase (arglist-dummy.string-representation instruction)))
(symbol
(string-downcase instruction))))
(instr-fn
#+#.(swank/backend:with-symbol 'inst-emitter-symbol 'sb-assem)
(sb-assem::inst-emitter-symbol instr-name)
#+(and
(not #.(swank/backend:with-symbol 'inst-emitter-symbol 'sb-assem))
#.(swank/backend:with-symbol '*assem-instructions* 'sb-assem))
(gethash instr-name sb-assem:*assem-instructions*)))
(cond ((not instr-fn)
(call-next-method))
((functionp instr-fn)
(with-available-arglist (arglist) (arglist instr-fn)
(decode-instruction-arglist instr-name arglist)))
(t
(assert (symbolp instr-fn))
(with-available-arglist (arglist) (arglist instr-fn)
;; SB-ASSEM:INST invokes a symbolic INSTR-FN with
;; current segment and current vop implicitly.
(decode-instruction-arglist instr-name
(if (get instr-fn :macro)
arglist
(cddr arglist)))))))))))
) ; PROGN
(provide :swank-sbcl-exts)
|
