;; these are not in the params because they only exist at compile time
(defparameter ,(format-table-name) (make-hash-table))
(defparameter ,(arg-type-table-name) nil)
- (defparameter ,(function-cache-name) (make-function-cache)))
+ (defparameter ,(fun-cache-name) (make-fun-cache)))
(let ((params
(or sb!c:*backend-disassem-params*
(setf sb!c:*backend-disassem-params* (make-params)))))
|#
\f
;;;; cached functions
+;;;;
+;;;; FIXME: Is it important to cache these? For performance? Or why?
+;;;; If performance: *Really*? How fast does disassembly need to be??
+;;;; So: Could we just punt this?
-(defstruct (function-cache (:copier nil))
+(defstruct (fun-cache (:copier nil))
(printers nil :type list)
(labellers nil :type list)
(prefilters nil :type list))
-(defvar *disassem-function-cache* (make-function-cache))
-(declaim (type function-cache *disassem-function-cache*))
+(defvar *disassem-fun-cache* (make-fun-cache))
+(declaim (type fun-cache *disassem-fun-cache*))
\f
;;;; A DCHUNK contains the bits we look at to decode an
;;;; instruction.
(defvar *disassem-inst-formats* (make-hash-table))
(defvar *disassem-arg-types* nil)
-(defvar *disassem-function-cache* (make-function-cache))
+(defvar *disassem-fun-cache* (make-fun-cache))
-(defstruct (argument (:conc-name arg-)
- (:copier nil))
+(defstruct (arg (:copier nil)
+ (:predicate nil))
(name nil :type symbol)
(fields nil :type list)
(munge-fun-refs (cddr override) evalp)))
overrides))
-(defparameter *arg-function-params*
+(defparameter *arg-fun-params*
'((:printer . (value stream dstate))
(:use-label . (value dstate))
(:prefilter . (value dstate))))
(wrapper-defs nil))
((null tail)
(values params (nreverse wrapper-defs)))
- (let ((fun-arg (assoc (car tail) *arg-function-params*)))
+ (let ((fun-arg (assoc (car tail) *arg-fun-params*)))
(when fun-arg
(let* ((fun-form (cadr tail))
(quoted-fun-form `',fun-form))
`(let* ((*current-instruction-flavor* ',(cons base-name format-name))
(,format-var (format-or-lose ',format-name))
(args ,(gen-args-def-form field-defs format-var evalp))
- (funcache *disassem-function-cache*))
+ (funcache *disassem-fun-cache*))
(multiple-value-bind (printer-fun printer-defun)
(find-printer-fun ',uniquified-name
',format-name
fields, they are all sign-extended.
:TYPE arg-type-name
- Inherit any properties of the given argument-type.
+ Inherit any properties of the given argument type.
:PREFILTER function
A function which is called (along with all other prefilters, in the
(let* ((arg-pos (position arg-name args :key #'arg-name))
(arg
(if (null arg-pos)
- (let ((arg (make-argument :name arg-name)))
+ (let ((arg (make-arg :name arg-name)))
(if (null args)
(setf args (list arg))
(push arg (cdr (last args))))
(car (push (cons kind nil) (cdr this-arg-temps))))))
(setf (cdr this-kind-temps) (cons vars forms)))))
\f
-(defmacro define-argument-type (name &rest args)
- #!+sb-doc
- "DEFINE-ARGUMENT-TYPE Name {Key Value}*
- Define a disassembler argument type NAME (which can then be referenced in
- another argument definition using the :TYPE argument). &KEY args are:
-
- :SIGN-EXTEND boolean
- If non-NIL, the raw value of this argument is sign-extended.
-
- :TYPE arg-type-name
- Inherit any properties of given argument-type.
-
- :PREFILTER function
- A function which is called (along with all other prefilters, in the
- order that their arguments appear in the instruction- format) before
- any printing is done, to filter the raw value. Any uses of READ-SUFFIX
- must be done inside a prefilter.
-
- :PRINTER function-string-or-vector
- A function, string, or vector which is used to print an argument of
- this type.
-
- :USE-LABEL
- If non-NIL, the value of an argument of this type is used as an
- address, and if that address occurs inside the disassembled code, it is
- replaced by a label. If this is a function, it is called to filter the
- value."
+;;; DEFINE-ARG-TYPE Name {Key Value}*
+;;;
+;;; Define a disassembler argument type NAME (which can then be referenced in
+;;; another argument definition using the :TYPE argument). &KEY args are:
+;;;
+;;; :SIGN-EXTEND boolean
+;;; If non-NIL, the raw value of this argument is sign-extended.
+;;;
+;;; :TYPE arg-type-name
+;;; Inherit any properties of given arg-type.
+;;;
+;;; :PREFILTER function
+;;; A function which is called (along with all other prefilters,
+;;; in the order that their arguments appear in the instruction-
+;;; format) before any printing is done, to filter the raw value.
+;;; Any uses of READ-SUFFIX must be done inside a prefilter.
+;;;
+;;; :PRINTER function-string-or-vector
+;;; A function, string, or vector which is used to print an argument of
+;;; this type.
+;;;
+;;; :USE-LABEL
+;;; If non-NIL, the value of an argument of this type is used as
+;;; an address, and if that address occurs inside the disassembled
+;;; code, it is replaced by a label. If this is a function, it is
+;;; called to filter the value.
+(defmacro define-arg-type (name &rest args)
(gen-arg-type-def-form name args))
+;;; Generate a form to define a disassembler argument type. See
+;;; DEFINE-ARG-TYPE for more information.
(defun gen-arg-type-def-form (name args &optional (evalp t))
- #!+sb-doc
- "Generate a form to define a disassembler argument type. See
- DEFINE-ARGUMENT-TYPE for more info."
(multiple-value-bind (args wrapper-defs)
(munge-fun-refs args evalp t name)
`(progn
(valsrc-value thing)
thing))
\f
-(defstruct (cached-function (:conc-name cached-fun-)
- (:copier nil))
+(defstruct (cached-fun (:conc-name cached-fun-)
+ (:copier nil))
(funstate nil :type (or null funstate))
(constraint nil :type list)
(name nil :type (or null symbol)))
-(defun find-cached-function (cached-funs args constraint)
+(defun find-cached-fun (cached-funs args constraint)
(dolist (cached-fun cached-funs nil)
(let ((funstate (cached-fun-funstate cached-fun)))
(when (and (equal constraint (cached-fun-constraint cached-fun))
(funstate-compatible-p funstate args)))
(return cached-fun)))))
-(defmacro !with-cached-function ((name-var
- funstate-var
- cache
- cache-slot
- args
- &key
- constraint
- (stem (missing-arg)))
- &body defun-maker-forms)
+(defmacro !with-cached-fun ((name-var
+ funstate-var
+ cache
+ cache-slot
+ args
+ &key
+ constraint
+ (stem (missing-arg)))
+ &body defun-maker-forms)
(let ((cache-var (gensym))
(constraint-var (gensym)))
`(let* ((,constraint-var ,constraint)
- (,cache-var (find-cached-function (,cache-slot ,cache)
- ,args ,constraint-var)))
+ (,cache-var (find-cached-fun (,cache-slot ,cache)
+ ,args ,constraint-var)))
(cond (,cache-var
(values (cached-fun-name ,cache-var) nil))
(t
(let* ((,name-var (symbolicate "CACHED-FUN--" ,stem))
(,funstate-var (make-funstate ,args))
(,cache-var
- (make-cached-function :name ,name-var
- :funstate ,funstate-var
- :constraint ,constraint-var)))
+ (make-cached-fun :name ,name-var
+ :funstate ,funstate-var
+ :constraint ,constraint-var)))
(values ,name-var
`(progn
,(progn ,@defun-maker-forms)
(if (null printer-source)
(values nil nil)
(let ((printer-source (preprocess-printer printer-source args)))
- (!with-cached-function
- (name funstate cache function-cache-printers args
+ (!with-cached-fun
+ (name funstate cache fun-cache-printers args
:constraint printer-source
:stem (concatenate 'string
(string %name)
(mapcar #'arg-name (remove-if-not #'arg-use-label args))))
(if (null labelled-fields)
(values nil nil)
- (!with-cached-function
- (name funstate cache function-cache-labellers args
+ (!with-cached-fun
+ (name funstate cache fun-cache-labellers args
:stem (concatenate 'string "LABELLER-" (string %name))
:constraint labelled-fields)
(let ((labels-form 'labels))
(remove-if-not #'arg-prefilter args))))
(if (null filtered-args)
(values nil nil)
- (!with-cached-function
- (name funstate cache function-cache-prefilters args
+ (!with-cached-fun
+ (name funstate cache fun-cache-prefilters args
:stem (concatenate 'string
(string %name)
"-"
projects / sbcl.git / blobdiff