(defvar *code-segment* nil)
(defvar *elsewhere* nil)
(defvar *elsewhere-label* nil)
+#!+inline-constants
+(progn
+ (defvar *constant-segment* nil)
+ (defvar *constant-table* nil)
+ (defvar *constant-vector* nil))
+
\f
;;;; noise to emit an instruction trace
(setf *elsewhere*
(sb!assem:make-segment :type :elsewhere
:run-scheduler (default-segment-run-scheduler)
- :inst-hook (default-segment-inst-hook)))
+ :inst-hook (default-segment-inst-hook)
+ :alignment 0))
+ #!+inline-constants
+ (setf *constant-segment*
+ (sb!assem:make-segment :type :elsewhere
+ :run-scheduler nil
+ :inst-hook (default-segment-inst-hook)
+ :alignment 0)
+ *constant-table* (make-hash-table :test #'equal)
+ *constant-vector* (make-array 16 :adjustable t :fill-pointer 0))
(values))
(defun generate-code (component)
;; Align first emitted block of each loop: x86 and x86-64 both
;; like 16 byte alignment, however, since x86 aligns code objects
;; on 8 byte boundaries we cannot guarantee proper loop alignment
- ;; there (yet.)
- #!+x86-64
- (let ((cloop (sb!c::block-loop 1block)))
- (when (and cloop
- (sb!c::loop-tail cloop)
- (not (sb!c::loop-info cloop)))
- (sb!assem:align sb!vm:n-lowtag-bits #x90)
- ;; Mark the loop as aligned by saving the IR1 block aligned.
- (setf (sb!c::loop-info cloop) 1block)))
- (sb!assem:emit-label (block-label 1block)))
+ ;; there (yet.) Only x86-64 does something with ALIGNP, but
+ ;; it may be useful in the future.
+ (let ((alignp (let ((cloop (block-loop 1block)))
+ (when (and cloop
+ (loop-tail cloop)
+ (not (loop-info cloop)))
+ ;; Mark the loop as aligned by saving the IR1 block aligned.
+ (setf (loop-info cloop) 1block)
+ t))))
+ (emit-block-header (block-label 1block)
+ (ir2-block-%trampoline-label block)
+ (ir2-block-dropped-thru-to block)
+ alignp)))
(let ((env (block-physenv 1block)))
(unless (eq env prev-env)
(let ((lab (gen-label)))
(template-name (vop-info vop)))))))
(sb!assem:append-segment *code-segment* *elsewhere*)
(setf *elsewhere* nil)
+ #!+inline-constants
+ (progn
+ (unless (zerop (length *constant-vector*))
+ (let ((constants (sb!vm:sort-inline-constants *constant-vector*)))
+ (assemble (*constant-segment*)
+ (sb!vm:emit-constant-segment-header
+ *constant-segment*
+ constants
+ (do-ir2-blocks (2block component nil)
+ (when (policy (block-last (ir2-block-block 2block))
+ (> speed space))
+ (return t))))
+ (map nil (lambda (constant)
+ (sb!vm:emit-inline-constant (car constant) (cdr constant)))
+ constants)))
+ (sb!assem:append-segment *code-segment* *constant-segment*))
+ (setf *constant-segment* nil
+ *constant-vector* nil
+ *constant-table* nil))
(values (sb!assem:finalize-segment *code-segment*)
(nreverse *trace-table-info*)
*fixup-notes*)))
(label-position label-or-posn))
(index
label-or-posn))))
+
+#!+inline-constants
+(defun register-inline-constant (&rest constant-descriptor)
+ (declare (dynamic-extent constant-descriptor))
+ (let ((constant (sb!vm:canonicalize-inline-constant constant-descriptor)))
+ (or (gethash constant *constant-table*)
+ (multiple-value-bind (label value) (sb!vm:inline-constant-value constant)
+ (vector-push-extend (cons constant label) *constant-vector*)
+ (setf (gethash constant *constant-table*) value)))))