From aab81dccfb1a311eac523a855004a3669340aca6 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 1 Dec 2008 19:32:33 +0000 Subject: [PATCH] 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. --- src/code/debug-int.lisp | 3 +-- src/code/target-load.lisp | 6 ++---- src/compiler/generic/genesis.lisp | 2 +- src/compiler/generic/target-core.lisp | 14 ++++++++++++-- src/compiler/x86-64/alloc.lisp | 28 ---------------------------- src/compiler/x86/alloc.lisp | 27 --------------------------- src/runtime/alloc.c | 21 +++++++++++++++++++++ version.lisp-expr | 2 +- 8 files changed, 38 insertions(+), 65 deletions(-) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 4b6be6d..f2e6012 100644 --- 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 --- 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 --- 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 --- 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 --- 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))) (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 --- 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))) (define-vop (make-fdefn) (:policy :fast-safe) diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c index 896467c..5b6419c 100644 --- 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 --- 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" -- 1.7.10.4