From: Paul K. <pk...@us...> - 2009-06-28 21:37:09
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv32093/src/compiler Modified Files: codegen.lisp early-c.lisp main.lisp Log Message: 1.0.29.54: Inline unboxed constants on x86[-64] * New build-time feature: inline-constants, which specifies that SB!C and SB!VM implement a protocol described in base-target-features.lisp-expr. Backends implementing that feature are able to load constants from code components, in a section that follows the actual executable code. * Implement the protocol on x86 and x86-64, and use it for float constants, and, on x86-64 only, mid-sized (> 2^(29-32), but still machine-sized) integers. * Use the new feature in integer and float arithmetic VOPs. * Adjust a few test cases to take newly consing situations into account. * Clean-up: - New build-time feature: float-eql-vops, which disable rewriting EQL of single and double floats in terms of foo-float*-bits. - Fix a typo (unused variable lookup) in TWO-ARG-+/- Index: codegen.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/codegen.lisp,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- codegen.lisp 20 Sep 2008 03:09:58 -0000 1.12 +++ codegen.lisp 28 Jun 2009 21:37:05 -0000 1.13 @@ -59,6 +59,12 @@ (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)) + ;;;; noise to emit an instruction trace @@ -111,7 +117,16 @@ (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) @@ -163,6 +178,24 @@ (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 + 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*))) @@ -178,3 +211,12 @@ (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))))) Index: early-c.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/early-c.lisp,v retrieving revision 1.48 retrieving revision 1.49 diff -u -d -r1.48 -r1.49 --- early-c.lisp 24 Apr 2009 10:06:20 -0000 1.48 +++ early-c.lisp 28 Jun 2009 21:37:05 -0000 1.49 @@ -104,6 +104,11 @@ (defvar *fixup-notes*) (defvar *in-pack*) (defvar *info-environment*) +#!+inline-constants +(progn + (defvar *constant-segment*) + (defvar *constant-table*) + (defvar *constant-vector*)) (defvar *lexenv*) (defvar *source-info*) (defvar *source-plist*) Index: main.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/main.lisp,v retrieving revision 1.144 retrieving revision 1.145 diff -u -d -r1.144 -r1.145 --- main.lisp 25 Jun 2009 10:32:56 -0000 1.144 +++ main.lisp 28 Jun 2009 21:37:05 -0000 1.145 @@ -448,7 +448,13 @@ (defun %compile-component (component) (let ((*code-segment* nil) - (*elsewhere* nil)) + (*elsewhere* nil) + #!+inline-constants + (*constant-segment* nil) + #!+inline-constants + (*constant-table* nil) + #!+inline-constants + (*constant-vector* nil)) (maybe-mumble "GTN ") (gtn-analyze component) (maybe-mumble "LTN ") |