1.0.23.6: move code-object allocation to C side on x86 and x86-64

 (Code and data separation 1/5.)

 * Replace VOPs with alloc_code in alloc.c.

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 4b6be6d..f2e6012 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -3306,8 +3306,7 @@ register."
           (trap-loc (foreign-symbol-sap "fun_end_breakpoint_trap"))
           (length (sap- src-end src-start))
           (code-object
-           (%primitive sb!c:allocate-code-object (1+ bogus-lra-constants)
-                       length))
+           (sb!c:allocate-code-object (1+ bogus-lra-constants) length))
           (dst-start (code-instructions code-object)))
      (declare (type system-area-pointer
                     src-start src-end dst-start trap-loc)

diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index 219aba0..31d6102 100644 (file)
--- a/src/code/target-load.lisp
+++ b/src/code/target-load.lisp
@@ -200,7 +200,7 @@
 (defun load-code (box-num code-length)
   (declare (fixnum box-num code-length))
   (with-fop-stack t
-    (let ((code (%primitive sb!c:allocate-code-object box-num code-length))
+    (let ((code (sb!c:allocate-code-object box-num code-length))
           (index (+ sb!vm:code-trace-table-offset-slot box-num)))
       (declare (type index index))
       (setf (%code-debug-info code) (pop-stack))
@@ -246,9 +246,7 @@
                       tto)
               (format t "   loading to the dynamic space~%"))
 
-        (let ((code (%primitive sb!c:allocate-code-object
-                                box-num
-                                code-length))
+        (let ((code (sb!c:allocate-code-object box-num code-length))
               (index (+ sb!vm:code-trace-table-offset-slot box-num)))
           (declare (type index index))
           (when *load-code-verbose*

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index 843cc73..bc6b7f5 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -2705,7 +2705,7 @@ core and return a descriptor to it."
               (maybe-record-with-munged-name "-TRAP" "trap_" 3)
               (maybe-record-with-munged-name "-SUBTYPE" "subtype_" 4)
               (maybe-record-with-munged-name "-SC-NUMBER" "sc_" 5)
-              (maybe-record-with-translated-name '("-START" "-END" "-SIZE") 6)
+              (maybe-record-with-translated-name '("-START" "-END" "-SIZE" "-SHIFT") 6)
               (maybe-record-with-translated-name '("-CORE-ENTRY-TYPE-CODE") 7)
               (maybe-record-with-translated-name '("-CORE-SPACE-ID") 8))))))
     ;; KLUDGE: these constants are sort of important, but there's no

diff --git a/src/compiler/generic/target-core.lisp b/src/compiler/generic/target-core.lisp
index c07f5e5..d70ede9 100644 (file)
--- a/src/compiler/generic/target-core.lisp
+++ b/src/compiler/generic/target-core.lisp
@@ -16,6 +16,17 @@
 
 (in-package "SB!C")
 
+(declaim (ftype (function (fixnum fixnum) (values code-component &optional))
+                allocate-code-object))
+(defun allocate-code-object (boxed unboxed)
+  #!+gencgc
+  (without-gcing
+    (%make-lisp-obj
+     (alien-funcall (extern-alien "alloc_code_object" (function unsigned-long unsigned unsigned))
+                    boxed unboxed)))
+  #!-gencgc
+  (%primitive allocate-code-object boxed unboxed))
+
 ;;; Make a function entry, filling in slots from the ENTRY-INFO.
 (defun make-fun-entry (entry-info code-obj object)
   (declare (type entry-info entry-info) (type core-object object))
@@ -51,8 +62,7 @@
            (total-length (+ length
                             (ceiling trace-table-bits sb!vm:n-byte-bits)))
            (box-num (- (length constants) sb!vm:code-trace-table-offset-slot))
-           (code-obj
-            (%primitive allocate-code-object box-num total-length))
+           (code-obj (allocate-code-object box-num total-length))
            (fill-ptr (code-instructions code-obj)))
       (declare (type index box-num total-length))
 

diff --git a/src/compiler/x86-64/alloc.lisp b/src/compiler/x86-64/alloc.lisp
index dfcf4bf..22b18a3 100644 (file)
--- a/src/compiler/x86-64/alloc.lisp
+++ b/src/compiler/x86-64/alloc.lisp
@@ -123,34 +123,6 @@
     (inst stos zero)))
 
 (in-package "SB!VM")
-
-;;;
-(define-vop (allocate-code-object)
-  (:args (boxed-arg :scs (any-reg) :target boxed)
-         (unboxed-arg :scs (any-reg) :target unboxed))
-  (:results (result :scs (descriptor-reg) :from :eval))
-  (:temporary (:sc unsigned-reg :from (:argument 0)) boxed)
-  (:temporary (:sc unsigned-reg :from (:argument 1)) unboxed)
-  (:node-var node)
-  (:generator 100
-    (move boxed boxed-arg)
-    (inst add boxed (fixnumize (1+ code-trace-table-offset-slot)))
-    (inst and boxed (lognot lowtag-mask))
-    (move unboxed unboxed-arg)
-    (inst shr unboxed word-shift)
-    (inst add unboxed lowtag-mask)
-    (inst and unboxed (lognot lowtag-mask))
-    (inst mov result boxed)
-    (inst add result unboxed)
-    (pseudo-atomic
-     (allocation result result node)
-     (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag))
-     (inst shl boxed (- n-widetag-bits word-shift))
-     (inst or boxed code-header-widetag)
-     (storew boxed result 0 other-pointer-lowtag)
-     (storew unboxed result code-code-size-slot other-pointer-lowtag)
-     (storew nil-value result code-entry-points-slot other-pointer-lowtag))
-    (storew nil-value result code-debug-info-slot other-pointer-lowtag)))
 \f
 (define-vop (make-fdefn)
   (:policy :fast-safe)

diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp
index c66be9c..fa97650 100644 (file)
--- a/src/compiler/x86/alloc.lisp
+++ b/src/compiler/x86/alloc.lisp
@@ -152,33 +152,6 @@
     (inst rep)
     (inst stos zero)))
 
-;;;
-(define-vop (allocate-code-object)
-  (:args (boxed-arg :scs (any-reg) :target boxed)
-         (unboxed-arg :scs (any-reg) :target unboxed))
-  (:results (result :scs (descriptor-reg) :from :eval))
-  (:temporary (:sc unsigned-reg :from (:argument 0)) boxed)
-  (:temporary (:sc unsigned-reg :from (:argument 1)) unboxed)
-  (:node-var node)
-  (:generator 100
-    (move boxed boxed-arg)
-    (inst add boxed (fixnumize (1+ code-trace-table-offset-slot)))
-    (inst and boxed (lognot lowtag-mask))
-    (move unboxed unboxed-arg)
-    (inst shr unboxed word-shift)
-    (inst add unboxed lowtag-mask)
-    (inst and unboxed (lognot lowtag-mask))
-    (inst mov result boxed)
-    (inst add result unboxed)
-    (pseudo-atomic
-     (allocation result result node)
-     (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag))
-     (inst shl boxed (- n-widetag-bits word-shift))
-     (inst or boxed code-header-widetag)
-     (storew boxed result 0 other-pointer-lowtag)
-     (storew unboxed result code-code-size-slot other-pointer-lowtag)
-     (storew nil-value result code-entry-points-slot other-pointer-lowtag))
-    (storew nil-value result code-debug-info-slot other-pointer-lowtag)))
 \f
 (define-vop (make-fdefn)
   (:policy :fast-safe)

diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c
index 896467c..5b6419c 100644 (file)
--- a/src/runtime/alloc.c
+++ b/src/runtime/alloc.c
@@ -28,6 +28,7 @@
 #include "genesis/cons.h"
 #include "genesis/bignum.h"
 #include "genesis/sap.h"
+#include "genesis/code.h"
 
 #define ALIGNED_SIZE(n) ((n) + LOWTAG_MASK) & ~LOWTAG_MASK
 
@@ -165,3 +166,23 @@ alloc_sap(void *ptr)
     sap->pointer = ptr;
     return make_lispobj(sap,OTHER_POINTER_LOWTAG);
 }
+
+lispobj
+alloc_code_object (unsigned boxed, unsigned unboxed) {
+    struct code * code;
+    unsigned size;
+    boxed = make_fixnum(boxed + 1 + 4); /* 4 == trace_table_offset offset in words */
+    boxed &= ~LOWTAG_MASK;
+
+    unboxed += LOWTAG_MASK;
+    unboxed &= ~LOWTAG_MASK;
+
+    code = (struct code *) pa_alloc(ALIGNED_SIZE((boxed + unboxed) * sizeof(lispobj)));
+
+    boxed = boxed << (N_WIDETAG_BITS - WORD_SHIFT);
+    code->header = boxed | CODE_HEADER_WIDETAG;
+    code->code_size = unboxed;
+    code->entry_points = NIL;
+    code->debug_info = NIL;
+    return make_lispobj(code, OTHER_POINTER_LOWTAG);
+}

diff --git a/version.lisp-expr b/version.lisp-expr
index 0fcbf52..0ff68ef 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.23.5"
+"1.0.23.6"