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-+/-

NEWS

@@ -9,8 +9,6 @@
     values in other threads.
   * new feature: SB-INTROSPECT:ALLOCATION-INFORMATION provides information
     about object allocation.
-  * optimization: more efficient complex float and real float operations
-    on x86-64.
   * optimization: division of a real float by a complex float is implemented
     with a specialised code sequence.
   * optimization: MAKE-INSTANCE with non-constant class-argument but constant
@@ -31,6 +29,14 @@
   * optimization: the compiler now derives simple types for LOAD-VALUE-FORMs.
   * improvement: less unsafe constant folding in floating point arithmetic,
     especially for mixed complex/real -float operations.
+  * optimization: constant double and single floats are stored in native
+    unboxed format on x86[-64].
+  * optimization: smarter code for arithmetic operations with constant floats,
+    complex floats, or integers on x86[-64].
+  * optimization: smarter code for conjugate/multiplication of float complexes
+    and abs/negate of floats on x86-64.
+  * optimization: more efficient complex float and real float operations on
+    x86-64.
   * improvement: complex float division is slightly more stable.
   * improvement: DESCRIBE output has been reworked to be easier to read and
     contains more pertinent information.

base-target-features.lisp-expr

@@ -167,6 +167,42 @@
  ;;
  ; :complex-float-vops
 
+ ;; Enabled automatically for platforms which implement VOPs for EQL
+ ;; of single and double floats.
+ ;;
+ ; :float-eql-vops
+
+ ;; Enabled automatically for platform that can implement inline constants.
+ ;;
+ ;; Such platform must implement 5 functions, in SB!VM:
+ ;; * canonicalize-inline-constant: converts a constant descriptor (list) into
+ ;;    a canonical description, to be used as a key in an EQUAL hash table
+ ;;    and to guide the generation of the constant itself.
+ ;; * inline-constant-value: given a canonical constant descriptor, computes
+ ;;    two values:
+ ;;     1. A label that will be used to emit the constant (usually a
+ ;;         sb!assem:label)
+ ;;     2. A value that will be returned to code generators referring to
+ ;;         the constant (on x86oids, an EA object)
+ ;; * sort-inline-constants: Receives a vector of unique constants;
+ ;;    the car of each entry is the constant descriptor, and the cdr the
+ ;;    corresponding label. Destructively returns a vector of constants
+ ;;    sorted in emission order. It could actually perform arbitrary
+ ;;    modifications to the vector, e.g. to fuse constants of different
+ ;;    size.
+ ;; * emit-constant-segment-header: receives the vector of sorted constants
+ ;;    and a flag (true iff speed > space). Expected to emit padding
+ ;;    of some sort between the ELSEWHERE segment and the constants, or some
+ ;;    metadata.
+ ;; * emit-inline-constant: receives a constant descriptor and its associated
+ ;;    label. Emits the constant.
+ ;;
+ ;; Implementing this features lets VOP generators use sb!c:register-inline-constant
+ ;; to get handles (as returned by sb!vm:inline-constant-value) from constant
+ ;; descriptors.
+ ;;
+ ; :inline-constants
+
  ;; Peter Van Eynde's increase-bulletproofness code for CMU CL
  ;;
  ;; Some of the code which was #+high-security before the fork has now

make-config.sh

@@ -281,7 +281,7 @@ if [ "$sbcl_arch" = "x86" ]; then
     printf ' :compare-and-swap-vops :unwind-to-frame-and-call-vop :raw-instance-init-vops' >> $ltf
     printf ' :stack-allocatable-closures :stack-allocatable-vectors' >> $ltf
     printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf
-    printf ' :alien-callbacks :cycle-counter' >> $ltf
+    printf ' :alien-callbacks :cycle-counter :inline-constants ' >> $ltf
     case "$sbcl_os" in
     linux | freebsd | netbsd | openbsd | sunos | darwin | win32)
         printf ' :linkage-table' >> $ltf
@@ -297,6 +297,7 @@ elif [ "$sbcl_arch" = "x86-64" ]; then
     printf ' :stack-allocatable-closures :stack-allocatable-vectors' >> $ltf
     printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf
     printf ' :alien-callbacks :cycle-counter :complex-float-vops' >> $ltf
+    printf ' :float-eql-vops :inline-constants ' >> $ltf
 elif [ "$sbcl_arch" = "mips" ]; then
     printf ' :linkage-table' >> $ltf
     printf ' :stack-allocatable-closures :stack-allocatable-vectors' >> $ltf

package-data-list.lisp-expr

@@ -312,6 +312,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
                "PRIMITIVE-TYPE-OR-LOSE" "PRIMITIVE-TYPE-VOP"
                "PRIMITIVE-TYPE-NAME" "PUSH-VALUES"
                "READ-PACKED-BIT-VECTOR" "READ-VAR-INTEGER" "READ-VAR-STRING"
+               #!+inline-constants "REGISTER-INLINE-CONSTANT"
                "RESET-STACK-POINTER" "RESTORE-DYNAMIC-STATE"
                "RETURN-MULTIPLE" "SAVE-DYNAMIC-STATE" "SB"
                "SB-ALLOCATED-SIZE" "SB-NAME" "SB-OR-LOSE" "SB-P" "SC" "SC-CASE"
@@ -2521,6 +2522,11 @@ structure representations"
                "GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER"
                "IMMEDIATE-CHARACTER-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER"
                "IMMEDIATE-SC-NUMBER"
+               #!+inline-constants "CANONICALIZE-INLINE-CONSTANT"
+               #!+inline-constants "INLINE-CONSTANT-VALUE"
+               #!+inline-constants "EMIT-CONSTANT-SEGMENT-HEADER"
+               #!+inline-constants "SORT-INLINE-CONSTANTS"
+               #!+inline-constants "EMIT-INLINE-CONSTANT"
                "INSTANCE-HEADER-WIDETAG" "INSTANCE-POINTER-LOWTAG"
                "INSTANCE-SLOTS-OFFSET" "INSTANCE-USAGE"
                "INTERIOR-REG-SC-NUMBER" "INTERNAL-ERROR-ARGS"

src/code/numbers.lisp

@@ -358,7 +358,7 @@
        (bignum-cross-fixnum ,op ,big-op)
        (float-contagion ,op x y)
 
-       ((complex complex) +
+       ((complex complex)
         (canonical-complex (,op (realpart x) (realpart y))
                            (,op (imagpart x) (imagpart y))))
        (((foreach bignum fixnum ratio single-float double-float

src/compiler/codegen.lisp

@@ -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)))))

src/compiler/early-c.lisp

@@ -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*)

src/compiler/generic/vm-macs.lisp

@@ -162,7 +162,7 @@
 (in-package "SB!C")
 
 ;;; the maximum number of SCs in any implementation
-(def!constant sc-number-limit 32)
+(def!constant sc-number-limit 40)
 
 ;;; Modular functions
 

src/compiler/generic/vm-tran.lisp

@@ -584,11 +584,11 @@
      (values)))
 
 ;;;; transforms for EQL of floating point values
-#!-x86-64
+#!-float-eql-vops
 (deftransform eql ((x y) (single-float single-float))
   '(= (single-float-bits x) (single-float-bits y)))
 
-#!-x86-64
+#!-float-eql-vops
 (deftransform eql ((x y) (double-float double-float))
   '(and (= (double-float-low-bits x) (double-float-low-bits y))
         (= (double-float-high-bits x) (double-float-high-bits y))))

src/compiler/main.lisp

@@ -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 ")