X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftarget-disassem.lisp;h=6e247fca37e18ca0f03e2d4448ba10628e941acd;hb=98a76d4426660876dec6649b1e228d2e5b47f579;hp=b004f451c3092293bdacb2c19bde1f384931f0b1;hpb=08307967c71c580058a503d46aa087cfefcf8c69;p=sbcl.git diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index b004f45..6e247fc 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -44,8 +44,9 @@ (sort insts #'> :key #'specializer-rank)) (defun specialization-error (insts) - (error "~@" - insts)) + (bug + "~@" + insts)) ;;; Given a list of instructions INSTS, Sees if one of these instructions is a ;;; more general form of all the others, in which case they are put into its @@ -275,71 +276,6 @@ (seg-virtual-location seg) (seg-code seg))))) -;;; All state during disassembly. We store some seemingly redundant -;;; information so that we can allow garbage collect during disassembly and -;;; not get tripped up by a code block being moved... -(defstruct (disassem-state (:conc-name dstate-) - (:constructor %make-dstate) - (:copier nil)) - ;; offset of current pos in segment - (cur-offs 0 :type offset) - ;; offset of next position - (next-offs 0 :type offset) - ;; a sap pointing to our segment - (segment-sap (missing-arg) :type sb!sys:system-area-pointer) - ;; the current segment - (segment nil :type (or null segment)) - ;; what to align to in most cases - (alignment sb!vm:n-word-bytes :type alignment) - (byte-order :little-endian - :type (member :big-endian :little-endian)) - ;; for user code to hang stuff off of - (properties nil :type list) - (filtered-values (make-array max-filtered-value-index) - :type filtered-value-vector) - ;; used for prettifying printing - (addr-print-len nil :type (or null (integer 0 20))) - (argument-column 0 :type column) - ;; to make output look nicer - (output-state :beginning - :type (member :beginning - :block-boundary - nil)) - - ;; alist of (address . label-number) - (labels nil :type list) - ;; same as LABELS slot data, but in a different form - (label-hash (make-hash-table) :type hash-table) - ;; list of function - (fun-hooks nil :type list) - - ;; alist of (address . label-number), popped as it's used - (cur-labels nil :type list) - ;; OFFS-HOOKs, popped as they're used - (cur-offs-hooks nil :type list) - - ;; for the current location - (notes nil :type list) - - ;; currently active source variables - (current-valid-locations nil :type (or null (vector bit)))) -(def!method print-object ((dstate disassem-state) stream) - (print-unreadable-object (dstate stream :type t) - (format stream - "+~W~@[ in ~S~]" - (dstate-cur-offs dstate) - (dstate-segment dstate)))) - -;;; Return the absolute address of the current instruction in DSTATE. -(defun dstate-cur-addr (dstate) - (the address (+ (seg-virtual-location (dstate-segment dstate)) - (dstate-cur-offs dstate)))) - -;;; Return the absolute address of the next instruction in DSTATE. -(defun dstate-next-addr (dstate) - (the address (+ (seg-virtual-location (dstate-segment dstate)) - (dstate-next-offs dstate)))) - ;;;; function ops (defun fun-self (fun) @@ -1531,9 +1467,7 @@ (compile nil lambda))) (defun compiled-fun-or-lose (thing &optional (name thing)) - (cond ((or (symbolp thing) - (and (listp thing) - (eq (car thing) 'setf))) + (cond ((legal-fun-name-p thing) (compiled-fun-or-lose (fdefinition thing) thing)) ((functionp thing) thing)