[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-07-2-gf9f78a4
Raymond Toy
rtoy at common-lisp.net
Fri Jul 13 03:51:08 UTC 2012
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via f9f78a47c59d5cbe762a8a571b66b788b27e45ff (commit)
via 2e95a0bb1011de96626271d6c4e367a6a8e7a6a4 (commit)
from 7933ebf6d092f5172db350473629155ff622c888 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit f9f78a47c59d5cbe762a8a571b66b788b27e45ff
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Jul 12 20:49:43 2012 -0700
Remove old inline allocation function and corresponding assembly routines.
diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index 5f7c397..9d955f4 100644
--- a/src/compiler/x86/macros.lisp
+++ b/src/compiler/x86/macros.lisp
@@ -137,47 +137,6 @@
(unless (and (tn-p size) (location= alloc-tn size))
(inst mov dst-tn size)))
-#+nil
-(defun inline-allocation (alloc-tn size)
- (let ((ok (gen-label)))
- ;;
- ;; Load the size first so that the size can be in the same
- ;; register as alloc-tn.
- (load-size alloc-tn alloc-tn size)
- ;;
- (inst add alloc-tn
- (make-symbol-value-ea '*current-region-free-pointer*))
- (inst cmp alloc-tn
- (make-symbol-value-ea '*current-region-end-addr*))
- (inst jmp :be OK)
- ;;
- ;; Dispatch to the appropriate overflow routine. There is a
- ;; routine for each destination.
- (ecase (tn-offset alloc-tn)
- (#.eax-offset
- (inst call (make-fixup (extern-alien-name "alloc_overflow_eax")
- :foreign)))
- (#.ecx-offset
- (inst call (make-fixup (extern-alien-name "alloc_overflow_ecx")
- :foreign)))
- (#.edx-offset
- (inst call (make-fixup (extern-alien-name "alloc_overflow_edx")
- :foreign)))
- (#.ebx-offset
- (inst call (make-fixup (extern-alien-name "alloc_overflow_ebx")
- :foreign)))
- (#.esi-offset
- (inst call (make-fixup (extern-alien-name "alloc_overflow_esi")
- :foreign)))
- (#.edi-offset
- (inst call (make-fixup (extern-alien-name "alloc_overflow_edi")
- :foreign))))
- (emit-label ok)
- (inst xchg (make-symbol-value-ea '*current-region-free-pointer*)
- alloc-tn))
- (values))
-
-;;#+nil
(defun inline-allocation (alloc-tn size)
(let ((ok (gen-label))
(done (gen-label)))
diff --git a/src/lisp/x86-assem.S b/src/lisp/x86-assem.S
index 465ab39..46640fa 100644
--- a/src/lisp/x86-assem.S
+++ b/src/lisp/x86-assem.S
@@ -553,124 +553,6 @@ ENDFUNC(alloc_to_edi)
#ifdef GENCGC
-/* Called from lisp when an inline allocation overflows.
- Every register except the result needs to be preserved.
- We depend on C to preserve ebx, esi, edi, and ebp.
- But where necessary must save eax, ecx, edx. */
-
-/* This routine handles an overflow with eax=crfp+size. So the
- size=eax-crfp. */
-FUNCDEF(alloc_overflow_eax)
- STACK_PROLOGUE(12)
- movl %ecx, 8(%esp) # Save ecx
- movl %edx, 4(%esp) # Save edx
- /* Calculate the size for the allocation. */
- subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%eax
- movl %eax, (%esp) # Push the size
- call GNAME(alloc)
- movl 4(%esp), %edx # Restore edx.
- movl 8(%esp), %ecx # Restore ecx.
- STACK_EPILOGUE
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
-ENDFUNC(alloc_overflow_eax)
-
-/* This routine handles an overflow with ecx=crfp+size. So the
- size=ecx-crfp. */
-FUNCDEF(alloc_overflow_ecx)
- STACK_PROLOGUE(12)
- movl %eax, 8(%esp) # Save eax
- movl %edx, 4(%esp) # Save edx
- /* Calculate the size for the allocation. */
- subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%ecx
- movl %ecx, (%esp) # Push the size
- call GNAME(alloc)
- movl %eax,%ecx # setup the destination.
- movl 4(%esp), %edx # Restore edx.
- movl 8(%esp), %eax # Restore eax.
- STACK_EPILOGUE
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
-ENDFUNC(alloc_overflow_ecx)
-
-/* This routine handles an overflow with edx=crfp+size. So the
- size=edx-crfp. */
-FUNCDEF(alloc_overflow_edx)
- STACK_PROLOGUE(12)
- movl %eax, 8(%esp) # Save eax
- movl %ecx, 4(%esp) # Save ecx
- /* Calculate the size for the allocation. */
- subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%edx
- movl %edx, (%esp) # Push the size
- call GNAME(alloc)
- movl %eax,%edx # setup the destination.
- movl 4(%esp), %ecx # Restore ecx.
- movl 8(%esp), %eax # Restore eax.
- STACK_EPILOGUE
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
-ENDFUNC(alloc_overflow_edx)
-
-/* This routine handles an overflow with ebx=crfp+size. So the
- size=ebx-crfp. */
-FUNCDEF(alloc_overflow_ebx)
- STACK_PROLOGUE(16)
- movl %eax, 12(%esp) # Save eax
- movl %ecx, 8(%esp) # Save ecx
- movl %edx, 4(%esp) # Save edx
- /* Calculate the size for the allocation. */
- subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%ebx
- movl %ebx, (%esp) # Push the size
- call GNAME(alloc)
- movl %eax,%ebx # setup the destination.
- movl 4(%esp), %edx # Restore edx.
- movl 8(%esp), %ecx # Restore ecx.
- movl 12(%esp), %eax # Restore eax.
- STACK_EPILOGUE
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
-ENDFUNC(alloc_overflow_ebx)
-
-/* This routine handles an overflow with esi=crfp+size. So the
- size=esi-crfp. */
-FUNCDEF(alloc_overflow_esi)
- STACK_PROLOGUE(16)
- movl %eax, 12(%esp) # Save eax
- movl %ecx, 8(%esp) # Save ecx
- movl %edx, 4(%esp) # Save edx
- /* Calculate the size for the allocation. */
- subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%esi
- movl %esi, (%esp) # Push the size
- call GNAME(alloc)
- movl %eax,%esi # setup the destination.
- movl 4(%esp), %edx # Restore edx.
- movl 8(%esp), %ecx # Restore ecx.
- movl 12(%esp), %eax # Restore eax.
- STACK_EPILOGUE
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
-ENDFUNC(alloc_overflow_esi)
-
-/* This routine handles an overflow with edi=crfp+size. So the
- size=edi-crfp. */
-FUNCDEF(alloc_overflow_edi)
- STACK_PROLOGUE(16)
- movl %eax, 12(%esp) # Save eax
- movl %ecx, 8(%esp) # Save ecx
- movl %edx, 4(%esp) # Save edx
- /* Calculate the size for the allocation. */
- subl CURRENT_REGION_FREE_POINTER + SYMBOL_VALUE_OFFSET,%edi
- movl %edi, (%esp) # Push the size
- call GNAME(alloc)
- movl %eax,%edi # setup the destination.
- movl 4(%esp), %edx # Restore edx.
- movl 8(%esp), %ecx # Restore ecx.
- movl 12(%esp), %eax # Restore eax.
- STACK_EPILOGUE
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
-ENDFUNC(alloc_overflow_edi)
-
/*
* alloc_overflow_x87 and alloc_overflow_sse2 must not be called from
* C because it doesn't follow C conventions.
@@ -703,7 +585,9 @@ FUNCDEF(alloc_overflow_sse2)
movl %edx, 16(%esp)
ldmxcsr 16(%esp) # Get new mxcsr value
movl %eax, (%esp) # Put size on stack for first arg to alloc()
+
call GNAME(alloc)
+
movl 4(%esp), %edx # Restore edx and ecx registers. eax has the return value.
movl 8(%esp), %ecx
ldmxcsr 12(%esp)
commit 2e95a0bb1011de96626271d6c4e367a6a8e7a6a4
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Wed Jul 11 22:00:07 2012 -0700
Clean up alloc overflow routine. Cross-compile needed.
src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp:
o X86 cross-compile script
src/compiler/x86/macros.lisp:
o New inline-allocation to call our new overflow routine.
src/lisp/x86-assem.S:
o New alloc_overflow routine.
src/tools/cross-scripts/cross-x86-x86.lisp:
o Export all symbols in VM that are external symbols in OLD-VM with
the corresponding symbol name.
diff --git a/src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp b/src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp
new file mode 100644
index 0000000..d9a5a3e
--- /dev/null
+++ b/src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp
@@ -0,0 +1,8 @@
+;;; Bootstrap for building the 2012-08 snapshot from the 2012-07
+;;; snapshot. The inline allocation routines are changing.
+
+;;; Nothing fancy needed; just use do a simple cross-build-world using
+;;; this as the script.
+#+x86
+(load "target:tools/cross-scripts/cross-x86-x86")
+
diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index 731bcf4..5f7c397 100644
--- a/src/compiler/x86/macros.lisp
+++ b/src/compiler/x86/macros.lisp
@@ -137,6 +137,7 @@
(unless (and (tn-p size) (location= alloc-tn size))
(inst mov dst-tn size)))
+#+nil
(defun inline-allocation (alloc-tn size)
(let ((ok (gen-label)))
;;
@@ -176,6 +177,50 @@
alloc-tn))
(values))
+;;#+nil
+(defun inline-allocation (alloc-tn size)
+ (let ((ok (gen-label))
+ (done (gen-label)))
+ ;;
+ ;; Load the size first so that the size can be in the same
+ ;; register as alloc-tn.
+ (load-size alloc-tn alloc-tn size)
+ ;;
+ (inst add alloc-tn
+ (make-symbol-value-ea '*current-region-free-pointer*))
+ (inst cmp alloc-tn
+ (make-symbol-value-ea '*current-region-end-addr*))
+ (inst jmp :be OK)
+
+ ;; Inline allocation didn't work so we need to call alloc, carefully.
+
+ ;; Recompute the size. Can't just reload size because it might
+ ;; have already been destroyed if size = alloc-tn (which does
+ ;; happen).
+ (inst sub alloc-tn (make-symbol-value-ea '*current-region-free-pointer*))
+ (case (tn-offset alloc-tn)
+ (#.eax-offset
+ (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87"
+ #+sse2 "alloc_overflow_sse2")
+ :foreign))
+ (inst jmp done))
+ (t
+ (inst push eax-tn) ; Save any value in eax
+ (inst mov eax-tn alloc-tn)
+ (inst call (make-fixup (extern-alien-name #-sse2 "alloc_overflow_x87"
+ #+sse2 "alloc_overflow_sse2")
+ :foreign))
+ (inst mov alloc-tn eax-tn) ; Save allocated address in alloc-tn
+ (inst pop eax-tn) ; Restore old value of eax
+ (inst jmp done)))
+
+ (emit-label ok)
+ (inst xchg (make-symbol-value-ea '*current-region-free-pointer*)
+ alloc-tn)
+ (emit-label done))
+
+ (values))
+
(defun not-inline-allocation (alloc-tn size)
;; C call to allocate via dispatch routines. Each destination has a
;; special entry point. The size may be a register or a constant.
@@ -240,7 +285,7 @@
Result-TN."
`(pseudo-atomic
(allocation ,result-tn (pad-data-block ,size) ,inline)
- (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,result-tn)
+ (storew (logior (ash (1- ,size) vm::type-bits) ,type-code) ,result-tn)
(inst lea ,result-tn
(make-ea :byte :base ,result-tn :disp other-pointer-type))
, at forms))
diff --git a/src/lisp/x86-assem.S b/src/lisp/x86-assem.S
index 19be973..465ab39 100644
--- a/src/lisp/x86-assem.S
+++ b/src/lisp/x86-assem.S
@@ -671,7 +671,47 @@ FUNCDEF(alloc_overflow_edi)
ret
ENDFUNC(alloc_overflow_edi)
-#endif
+/*
+ * alloc_overflow_x87 and alloc_overflow_sse2 must not be called from
+ * C because it doesn't follow C conventions.
+ *
+ * On entry:
+ * %eax = bytes to allocate
+ * On exit:
+ * %eax = address
+ */
+FUNCDEF(alloc_overflow_x87)
+ STACK_PROLOGUE(12)
+ movl %ecx, 8(%esp) # Save ecx and edx registers
+ movl %edx, 4(%esp)
+ movl %eax, (%esp) # Put size on stack for first arg to alloc()
+ call GNAME(alloc)
+ movl 4(%esp), %edx # Restore edx and ecx registers. eax has the return value.
+ movl 8(%esp), %ecx
+ STACK_EPILOGUE
+ ret
+ENDFUNC(alloc_overflow_x87)
+
+FUNCDEF(alloc_overflow_sse2)
+ STACK_PROLOGUE(20)
+ movl %ecx, 8(%esp) # Save ecx and edx registers
+ movl %edx, 4(%esp)
+ stmxcsr 12(%esp) # Save MXCSR
+ /* Clear the exceptions that might occurred */
+ movl 12(%esp), %edx
+ and $-64, %edx # Clear the exceptions
+ movl %edx, 16(%esp)
+ ldmxcsr 16(%esp) # Get new mxcsr value
+ movl %eax, (%esp) # Put size on stack for first arg to alloc()
+ call GNAME(alloc)
+ movl 4(%esp), %edx # Restore edx and ecx registers. eax has the return value.
+ movl 8(%esp), %ecx
+ ldmxcsr 12(%esp)
+ STACK_EPILOGUE
+ ret
+ENDFUNC(alloc_overflow_sse2)
+
+#endif /* GENCGC */
#ifdef LINKAGE_TABLE
diff --git a/src/tools/cross-scripts/cross-x86-x86.lisp b/src/tools/cross-scripts/cross-x86-x86.lisp
index aa4d84d..fa4e31c 100644
--- a/src/tools/cross-scripts/cross-x86-x86.lisp
+++ b/src/tools/cross-scripts/cross-x86-x86.lisp
@@ -46,6 +46,9 @@
(export 'vm::fixup-code-object "VM")
(export 'vm::sanctify-for-execution "VM")
+(do-external-symbols (sym "OLD-VM")
+ (export (intern (symbol-name sym) "VM") "VM"))
+
(load "target:tools/comcom")
;;; Load the new backend.
-----------------------------------------------------------------------
Summary of changes:
src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp | 8 ++
src/compiler/x86/macros.lisp | 52 +++++----
src/lisp/x86-assem.S | 142 +++++-----------------
src/tools/cross-scripts/cross-x86-x86.lisp | 3 +
4 files changed, 72 insertions(+), 133 deletions(-)
create mode 100644 src/bootfiles/20c/boot-2012-07-1-x86-cross.lisp
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list