;;;; files for more information.
(in-package "SB!DISASSEM")
-
-(file-comment
- "$Header$")
\f
;;; types and defaults
#|
(defmacro set-disassem-params (&rest args)
#!+sb-doc
- "Specify global disassembler params. Keyword arguments include:
+ "Specify global disassembler params. &KEY arguments include:
:INSTRUCTION-ALIGNMENT number
Minimum alignment of instructions, in bits.
\f
;;;; cached functions
-(defstruct function-cache
+(defstruct (function-cache (:copier nil))
(printers nil :type list)
(labellers nil :type list)
(prefilters nil :type list))
length
mask id
printer
- labeller prefilter control)))
+ labeller prefilter control))
+ (:copier nil))
(name nil :type (or symbol string))
(format-name nil :type (or symbol string))
;;;; an instruction space holds all known machine instructions in a form that
;;;; can be easily searched
-(defstruct (inst-space (:conc-name ispace-))
+(defstruct (inst-space (:conc-name ispace-)
+ (:copier nil))
(valid-mask dchunk-zero :type dchunk) ; applies to *children*
(choices nil :type list))
(def!method print-object ((ispace inst-space) stream)
(print-unreadable-object (ispace stream :type t :identity t)))
-(defstruct (inst-space-choice (:conc-name ischoice-))
+(defstruct (inst-space-choice (:conc-name ischoice-)
+ (:copier nil))
(common-id dchunk-zero :type dchunk) ; applies to *parent's* mask
(subspace (required-argument) :type (or inst-space instruction)))
\f
;;;; These are the kind of values we can compute for an argument, and
-;;;; how to compute them. The :checker functions make sure that a given
+;;;; how to compute them. The :CHECKER functions make sure that a given
;;;; argument is compatible with another argument for a given use.
(defvar *arg-form-kinds* nil)
-(defstruct arg-form-kind
+(defstruct (arg-form-kind (:copier nil))
(names nil :type list)
(producer (required-argument) :type function)
(checker (required-argument) :type function))
(prefilter nil)
(use-label nil))
-(defstruct (instruction-format (:conc-name format-))
+(defstruct (instruction-format (:conc-name format-)
+ (:copier nil))
(name nil)
(args nil :type list)
\f
;;; A FUNSTATE holds the state of any arguments used in a disassembly
;;; function.
-(defstruct (funstate (:conc-name funstate-) (:constructor %make-funstate))
+(defstruct (funstate (:conc-name funstate-)
+ (:constructor %make-funstate)
+ (:copier nil))
(args nil :type list)
(arg-temps nil :type list)) ; See below.
;;;; (notably functions), we sometimes use a VALSRC structure to keep track of
;;;; the source from which they were derived.
-(defstruct (valsrc (:constructor %make-valsrc))
+(defstruct (valsrc (:constructor %make-valsrc)
+ (:copier nil))
(value nil)
(source nil))
(eq (car form) 'function))
;; a function def
(let ((wrapper-name (symbolicate prefix "-" arg-name "-WRAPPER"))
- (wrapper-args nil))
- (dotimes (i (length funargs))
- (push (gensym) wrapper-args))
+ (wrapper-args (make-gensym-list (length funargs))))
(values `#',wrapper-name
`(defun ,wrapper-name ,wrapper-args
(funcall ,form ,@wrapper-args))))
arg ,args-var ',name)))
,args-var))))))))))
-;;; FIXME: old CMU CL version, doesn't work with SBCL bootstrapping
-;;; scheme, kept around for reference until I get the new sbcl-0.6.4
-;;; version to work, then can be deleted
-#|
-(defun gen-format-def-form (header descrips &optional (evalp t))
- #!+sb-doc
- "Generate a form to define an instruction format. See
- DEFINE-INSTRUCTION-FORMAT for more info."
- (when (atom header)
- (setf header (list header)))
- (destructuring-bind (name length &key default-printer include) header
- (let ((args-var (gensym))
- (length-var (gensym))
- (all-wrapper-defs nil)
- (arg-count 0))
- (collect ((arg-def-forms))
- (dolist (descrip descrips)
- (let ((name (pop descrip)))
- (multiple-value-bind (descrip wrapper-defs)
- (munge-fun-refs
- descrip evalp t (format nil "~:@(~A~)-~D" name arg-count))
- (arg-def-forms
- (update-args-form args-var `',name descrip evalp length-var))
- (setf all-wrapper-defs
- (nconc wrapper-defs all-wrapper-defs)))
- (incf arg-count)))
- `(progn
- ,@all-wrapper-defs
- (eval-when (:compile-toplevel :execute)
- (let ((,length-var ,length)
- (,args-var
- ,(and include
- `(copy-list
- (format-args
- (format-or-lose ,include))))))
- ,@(arg-def-forms)
- (setf (gethash ',name *disassem-inst-formats*)
- (make-instruction-format
- :name ',name
- :length (bits-to-bytes ,length-var)
- :default-printer ,(maybe-quote evalp default-printer)
- :args ,args-var))
- (eval
- `(progn
- ,@(mapcar #'(lambda (arg)
- (when (arg-fields arg)
- (gen-arg-access-macro-def-form
- arg ,args-var ',name)))
- ,args-var))))))))))
-|#
-
;;; FIXME: probably needed only at build-the-system time, not in
;;; final target system
(defun modify-or-add-arg (arg-name
;; just use the same as the forms
(setq vars nil))
(t
- (setq vars nil)
- (dotimes (i (length forms))
- (push (gensym) vars))))
+ (setq vars (make-gensym-list (length forms)))))
(set-arg-temps vars forms arg kind funstate)))
(or vars forms)))
#!+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 keyword argument). Keyword
- arguments are:
+ 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.
(valsrc-value thing)
thing))
\f
-(defstruct (cached-function (:conc-name cached-fun-))
+(defstruct (cached-function (:conc-name cached-fun-)
+ (:copier nil))
(funstate nil :type (or null funstate))
(constraint nil :type list)
(name nil :type (or null symbol)))
projects / sbcl.git / blobdiff