Diff of /src/compiler/x86-64/target-insts.lisp [5d1093] .. [4e815e] Maximize Restore

  Switch to unified view

a/src/compiler/x86-64/target-insts.lisp b/src/compiler/x86-64/target-insts.lisp
...
...
87
                   (sb!disassem:maybe-note-assembler-routine offset
87
                   (sb!disassem:maybe-note-assembler-routine offset
88
                                                             nil
88
                                                             nil
89
                                                             dstate))))
89
                                                             dstate))))
90
            (t
90
            (t
91
             (princ offset stream)))))))
91
             (princ offset stream)))))))
92
  (write-char #\] stream))
92
  (write-char #\] stream)
93
  #!+sb-thread
94
  (let ((disp (second value)))
95
    (when (and (eql (first value) #.(ash (tn-offset thread-base-tn) -1))
96
               (not (third value)) ; no index
97
               (typep disp '(integer 0 *)) ; positive displacement
98
               (sb!disassem::seg-code (sb!disassem:dstate-segment dstate)))
99
      ;; Try to reverse-engineer which thread-local binding this is
100
      (let* ((code (sb!disassem::seg-code (sb!disassem:dstate-segment dstate)))
101
             (header-n-words
102
              (ash (sap-ref-word (int-sap (get-lisp-obj-address code))
103
                                 (- other-pointer-lowtag)) -8))
104
             (tls-index (ash disp (- n-fixnum-tag-bits))))
105
        (loop for word-num from code-constants-offset below header-n-words
106
              for obj = (code-header-ref code word-num)
107
              when (and (symbolp obj) (= (symbol-tls-index obj) tls-index))
108
              do (return-from print-mem-ref
109
                   (sb!disassem:note
110
                    (lambda (stream) (format stream "tls: ~S" obj))
111
                    dstate))))
112
      ;; Or maybe we're looking at the 'struct thread' itself
113
      (when (< disp max-interrupts)
114
        (let* ((thread-slots (primitive-object-slots
115
                              (find 'thread *primitive-objects*
116
                                    :key #'primitive-object-name)))
117
               (slot (find (ash disp (- word-shift)) thread-slots
118
                           :key #'slot-offset)))
119
          (when slot
120
            (return-from print-mem-ref
121
              (sb!disassem:note
122
               (lambda (stream)
123
                 (format stream "thread.~(~A~)" (slot-name slot)))
124
               dstate))))))
125
    ;; One last thing to try ...
126
    ;; The TLS slot of static symbols is referenced in memory absolute mode.
127
    ;; [FIXME: this is of course pointless! Genesis should pick/wire the indices
128
    ;; of all static symbols]
129
    (when (and (not (first value)) (not (third value)) ; no base, index
130
               (typep disp '(integer 0 *)) ; positive displacement
131
               (<= static-space-start disp static-space-end))
132
      (dolist (symbol *static-symbols*)
133
        (when (= (+ (get-lisp-obj-address symbol) (- other-pointer-lowtag)
134
                    (ash symbol-tls-index-slot word-shift))
135
                 disp)
136
          (sb!disassem:note
137
           (lambda (stream) (format stream "~A.tls-index" symbol))
138
           dstate))))))
93
139
94
(in-package "SB!DISASSEM")
140
(in-package "SB!DISASSEM")
95
141
96
;; Pre-scan a disassembly segment list to find heuristically the start of
142
;; Pre-scan a disassembly segment list to find heuristically the start of
97
;; unboxed constants. This isn't done for disassembly of arbitrary memory,
143
;; unboxed constants. This isn't done for disassembly of arbitrary memory,