optimized. (lp#555201)
* optimization: MAP and MAP-INTO are more efficient for non-simple vectors,
when (> SPEED SPACE).
+ * optimization: local call trampolines (x86 and x86-64) are emitted
+ inline.
* meta-optimization: improved compilation speed, especially for large
functions. (lp#792363 and lp#394206)
* bug fix: bound derivation for floating point operations is now more
"DEFINE-STORAGE-CLASS" "DEFINE-VOP"
"DEFKNOWN" "DEFOPTIMIZER"
"DEFTRANSFORM" "DERIVE-TYPE"
+ "EMIT-BLOCK-HEADER"
"ENTRY-NODE-INFO-NLX-TAG" "ENTRY-NODE-INFO-ST-TOP"
"PHYSENV-DEBUG-LIVE-TN" "PHYSENV-LIVE-TN"
"FAST-SYMBOL-VALUE"
nvals)
(:temporary (:scs (non-descriptor-reg)) temp))
\f
+;;; This hook by the codegen lets us insert code before fall-thru entry points,
+;;; local-call entry points, and tail-call entry points. The default does
+;;; nothing.
+(defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
+ (declare (ignore fall-thru-p alignp))
+ (when trampoline-label
+ (emit-label trampoline-label))
+ (emit-label start-label))
+
+\f
;;;; local call with unknown values convention return
;;; Non-TR local call for a fixed number of values passed according to the
;; 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:emit-alignment 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)))
nvals)
(:temporary (:scs (non-descriptor-reg)) temp))
+\f
+;;; This hook in the codegen pass lets us insert code before fall-thru entry
+;;; points, local-call entry points, and tail-call entry points. The default
+;;; does nothing.
+(defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
+ (declare (ignore fall-thru-p alignp))
+ (when trampoline-label
+ (emit-label trampoline-label))
+ (emit-label start-label))
\f
;;;; Local call with unknown values convention return:
(emit-template node block template args nil
(list* (block-label consequent) not-p
info-args))
- (unless (drop-thru-p if alternative)
- (vop branch node block (block-label alternative))))
+ (if (drop-thru-p if alternative)
+ (register-drop-thru alternative)
+ (vop branch node block (block-label alternative))))
(t
(emit-template node block template args nil info-args)
(vop branch-if node block (block-label consequent) flags not-p)
- (unless (drop-thru-p if alternative)
- (vop branch node block (block-label alternative)))))))
+ (if (drop-thru-p if alternative)
+ (register-drop-thru alternative)
+ (vop branch node block (block-label alternative)))))))
;;; Convert an IF that isn't the DEST of a conditional template.
(defun ir2-convert-if (node block)
((node-tail-p node)
(ir2-convert-tail-local-call node block fun))
(t
- (let ((start (block-label (lambda-block fun)))
+ (let ((start (block-trampoline (lambda-block fun)))
(returns (tail-set-info (lambda-tail-set fun)))
(lvar (node-lvar node)))
(ecase (if returns
(aver (not named))
tn)))))))
((not (eq (ir2-block-next 2block) (block-info target)))
- (vop branch last 2block (block-label target)))))))
+ (vop branch last 2block (block-label target)))
+ (t
+ (register-drop-thru target))))))
(values))
nvals)
(:temporary (:scs (non-descriptor-reg)) temp))
+\f
+;;; This hook in the codegen pass lets us insert code before fall-thru entry
+;;; points, local-call entry points, and tail-call entry points. The default
+;;; does nothing.
+(defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
+ (declare (ignore fall-thru-p alignp))
+ (when trampoline-label
+ (emit-label trampoline-label))
+ (emit-label start-label))
\f
;;;; Local call with unknown values convention return:
nvals)
(:temporary (:scs (non-descriptor-reg)) temp))
+\f
+;;; This hook in the codegen pass lets us insert code before fall-thru entry
+;;; points, local-call entry points, and tail-call entry points. The default
+;;; does nothing.
+(defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
+ (declare (ignore fall-thru-p alignp))
+ (when trampoline-label
+ (emit-label trampoline-label))
+ (emit-label start-label))
\f
;;;; Local call with unknown values convention return:
nvals)
(:temporary (:scs (non-descriptor-reg)) temp))
+\f
+;;; This hook in the codegen pass lets us insert code before fall-thru entry
+;;; points, local-call entry points, and tail-call entry points. The default
+;;; does nothing.
+(defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
+ (declare (ignore fall-thru-p alignp))
+ (when trampoline-label
+ (emit-label trampoline-label))
+ (emit-label start-label))
\f
;;;; Local call with unknown values convention return:
(let ((2block (block-info block)))
(or (ir2-block-%label 2block)
(setf (ir2-block-%label 2block) (gen-label)))))
+(defun block-trampoline (block)
+ (declare (type cblock block))
+ (let ((2block (block-info block)))
+ (or (ir2-block-%trampoline-label 2block)
+ (setf (ir2-block-%trampoline-label 2block) (gen-label)))))
;;; Return true if Block is emitted immediately after the block ended by Node.
(defun drop-thru-p (node block)
(let ((next-block (ir2-block-next (block-info (node-block node)))))
(aver (eq node (block-last (node-block node))))
(eq next-block (block-info block))))
+(defun register-drop-thru (block)
+ (declare (type cblock block))
+ (let ((2block (block-info block)))
+ (setf (ir2-block-dropped-thru-to 2block) t))
+ nil)
;;; Link a list of VOPs from First to Last into Block, Before the specified
;;; VOP. If Before is NIL, insert at the end.
;; the assembler label that points to the beginning of the code for
;; this block, or NIL when we haven't assigned a label yet
(%label nil)
+ ;; the assembler label that points to the trampoline for this block,
+ ;; or NIL if unassigned yet. Only meaningful for local call targets.
+ (%trampoline-label nil)
+ ;; T if the preceding block assumes it can drop thru to %label
+ (dropped-thru-to nil)
;; list of LOCATION-INFO structures describing all the interesting
;; (to the debugger) locations in this block
(locations nil :type list))
(= (tn-offset return-pc) return-pc-save-offset))
(error "return-pc not on stack in standard save location?")))
-;;; Instead of JMPing to TARGET, CALL a trampoline that saves the
-;;; return pc and jumps. Although this is an incredibly stupid trick
-;;; the paired CALL/RET instructions are a big win.
-(defun make-local-call (target)
- (let ((tramp (gen-label)))
- (inst call tramp)
- (assemble (*elsewhere*)
- (emit-label tramp)
- (popw rbp-tn (frame-word-offset return-pc-save-offset))
- (inst jmp target))))
+;;; The local call convention doesn't fit that well with x86-style
+;;; calls. Emit a header for local calls to pop the return address
+;;; in the right place.
+(defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
+ (when (and fall-thru-p (or trampoline-label alignp))
+ (inst jmp start-label))
+ (when alignp
+ (emit-alignment n-lowtag-bits #x90))
+ (when trampoline-label
+ (emit-label trampoline-label)
+ (popw rbp-tn (frame-word-offset return-pc-save-offset)))
+ (emit-label start-label))
;;; Non-TR local call for a fixed number of values passed according to
;;; the unknown values convention.
(trace-table-entry trace-table-call-site)
(move rbp-tn fp)
(note-this-location vop :call-site)
- (make-local-call target)
+ (inst call target)
(default-unknown-values vop values nvals node)
(trace-table-entry trace-table-normal)))
(trace-table-entry trace-table-call-site)
(move rbp-tn fp)
(note-this-location vop :call-site)
- (make-local-call target)
+ (inst call target)
(note-this-location vop :unknown-return)
(receive-unknown-values values-start nvals start count node)
(trace-table-entry trace-table-normal)))
(trace-table-entry trace-table-call-site)
(move rbp-tn fp)
(note-this-location vop :call-site)
- (make-local-call target)
+ (inst call target)
(note-this-location vop :known-return)
(trace-table-entry trace-table-normal)))
\f
(= (tn-offset return-pc) return-pc-save-offset))
(error "return-pc not on stack in standard save location?")))
-;;; Instead of JMPing to TARGET, CALL a trampoline that saves the
-;;; return pc and jumps. Although this is an incredibly stupid trick
-;;; the paired CALL/RET instructions are a big win.
-(defun make-local-call (target)
- (let ((tramp (gen-label)))
- (inst call tramp)
- (assemble (*elsewhere*)
- (emit-label tramp)
- (popw ebp-tn (frame-word-offset return-pc-save-offset))
- (inst jmp target))))
+;;; The local call convention doesn't fit that well with x86-style
+;;; calls. Emit a header for local calls to pop the return address
+;;; in the right place.
+(defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
+ (declare (ignore alignp))
+ (when trampoline-label
+ (when fall-thru-p
+ (inst jmp start-label))
+ (emit-label trampoline-label)
+ (popw rbp-tn (frame-word-offset return-pc-save-offset)))
+ (emit-label start-label))
;;; Non-TR local call for a fixed number of values passed according to
;;; the unknown values convention.
(trace-table-entry trace-table-call-site)
(move ebp-tn fp)
(note-this-location vop :call-site)
- (make-local-call target)
+ (inst call target)
(default-unknown-values vop values nvals node)
(trace-table-entry trace-table-normal)))
(trace-table-entry trace-table-call-site)
(move ebp-tn fp)
(note-this-location vop :call-site)
- (make-local-call target)
+ (inst call target)
(note-this-location vop :unknown-return)
(receive-unknown-values values-start nvals start count node)
(trace-table-entry trace-table-normal)))
(trace-table-entry trace-table-call-site)
(move ebp-tn fp)
(note-this-location vop :call-site)
- (make-local-call target)
+ (inst call target)
(note-this-location vop :known-return)
(trace-table-entry trace-table-normal)))
\f
projects / sbcl.git / commitdiff