\f
;;; types and defaults
-(defconstant label-column-width 7)
+(def!constant label-column-width 7)
(deftype text-width () '(integer 0 1000))
(deftype alignment () '(integer 0 64))
(deftype length () '(unsigned-byte 24))
(deftype column () '(integer 0 1000))
-(defconstant max-filtered-value-index 32)
+(def!constant max-filtered-value-index 32)
(deftype filtered-value-index ()
`(integer 0 ,max-filtered-value-index))
(deftype filtered-value-vector ()
dchunk=
dchunk-count-bits))
-(defconstant dchunk-bits 32)
+(def!constant dchunk-bits 32)
(deftype dchunk ()
`(unsigned-byte ,dchunk-bits))
(deftype dchunk-index ()
`(integer 0 ,dchunk-bits))
-(defconstant dchunk-zero 0)
-(defconstant dchunk-one #xFFFFFFFF)
+(def!constant dchunk-zero 0)
+(def!constant dchunk-one #xFFFFFFFF)
(defun dchunk-extract (from pos)
(declare (type dchunk from))
(defvar *disassem-arg-types* nil)
(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))
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
+ (!with-cached-fun
(name funstate cache fun-cache-printers args
:constraint printer-source
:stem (concatenate 'string
(mapcar #'arg-name (remove-if-not #'arg-use-label args))))
(if (null labelled-fields)
(values nil nil)
- (!with-cached-function
+ (!with-cached-fun
(name funstate cache fun-cache-labellers args
:stem (concatenate 'string "LABELLER-" (string %name))
:constraint labelled-fields)
(remove-if-not #'arg-prefilter args))))
(if (null filtered-args)
(values nil nil)
- (!with-cached-function
+ (!with-cached-fun
(name funstate cache fun-cache-prefilters args
:stem (concatenate 'string
(string %name)
(declare (ignorable #'local-filter #'local-extract)
(inline (setf local-filtered-value)
local-filter local-extract))
- ;; Use them for side-effects only.
+ ;; Use them for side effects only.
(let* ,(make-arg-temp-bindings funstate)
,@(forms)))))))))
\f