X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fcodegen.lisp;h=b0107e189904b28852241eb0b94a1de53103b3d2;hb=74cf7a4d01664fbf72a662ba093ad67ca243b524;hp=1426716be9c02969dd6d666fddf7b356aa541d59;hpb=ca2d58fc8ab92eb5ab50ed4428af4b39866bd5f4;p=sbcl.git

diff --git a/src/compiler/codegen.lisp b/src/compiler/codegen.lisp
index 1426716..b0107e1 100644
--- a/src/compiler/codegen.lisp
+++ b/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)
@@ -136,16 +151,19 @@
             ;; 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)))
@@ -163,6 +181,25 @@
                     (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*)))
@@ -178,3 +215,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)))))