- (field-defs (filter-overrides field-defs evalp)))
- `(let* ((*current-instruction-flavor* ',(cons name format-name))
- (,format-var (format-or-lose ',format-name))
- (args ,(gen-args-def-form field-defs format-var evalp))
- (funcache *disassem-function-cache*))
- ;; FIXME: This should be SPEED 0 but can't be until we support
- ;; byte compilation of components of the SBCL system.
- ;;(declare (optimize (speed 0) (safety 0) (debug 0)))
- (multiple-value-bind (printer-fun printer-defun)
- (find-printer-fun ,(if (eq printer-form :default)
- `(format-default-printer ,format-var)
- (maybe-quote evalp printer-form))
- args funcache)
- (multiple-value-bind (labeller-fun labeller-defun)
- (find-labeller-fun args funcache)
- (multiple-value-bind (prefilter-fun prefilter-defun)
- (find-prefilter-fun args funcache)
- (multiple-value-bind (mask id)
- (compute-mask-id args)
- (values
- `(make-instruction ',',name
- ',',format-name
- ,',print-name-form
- ,(format-length ,format-var)
- ,mask
- ,id
- ,(and printer-fun `#',printer-fun)
- ,(and labeller-fun `#',labeller-fun)
- ,(and prefilter-fun `#',prefilter-fun)
- ,',control)
- `(progn
- ,@(and printer-defun (list printer-defun))
- ,@(and labeller-defun (list labeller-defun))
- ,@(and prefilter-defun (list prefilter-defun))))
- ))))))))
+ (field-defs (filter-overrides field-defs evalp)))
+ `(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*))
+ (multiple-value-bind (printer-fun printer-defun)
+ (find-printer-fun ',uniquified-name
+ ',format-name
+ ,(if (eq printer-form :default)
+ `(format-default-printer ,format-var)
+ (maybe-quote evalp printer-form))
+ args funcache)
+ (multiple-value-bind (labeller-fun labeller-defun)
+ (find-labeller-fun ',uniquified-name args funcache)
+ (multiple-value-bind (prefilter-fun prefilter-defun)
+ (find-prefilter-fun ',uniquified-name
+ ',format-name
+ args
+ funcache)
+ (multiple-value-bind (mask id)
+ (compute-mask-id args)
+ (values
+ `(make-instruction ',',base-name
+ ',',format-name
+ ,',print-name-form
+ ,(format-length ,format-var)
+ ,mask
+ ,id
+ ,(and printer-fun `#',printer-fun)
+ ,(and labeller-fun `#',labeller-fun)
+ ,(and prefilter-fun `#',prefilter-fun)
+ ,',control)
+ `(progn
+ ,@(and printer-defun (list printer-defun))
+ ,@(and labeller-defun (list labeller-defun))
+ ,@(and prefilter-defun (list prefilter-defun))))
+ ))))))))