CMUCL commit: sparc-tramp-assem-branch src (3 files)
Raymond Toy
rtoy at common-lisp.net
Sat Jul 17 15:39:30 CEST 2010
Date: Saturday, July 17, 2010 @ 09:39:30
Author: rtoy
Path: /project/cmucl/cvsroot/src
Tag: sparc-tramp-assem-branch
Modified: assembly/sparc/assem-rtns.lisp compiler/sparc/alloc.lisp
compiler/sparc/cell.lisp
The CLOSURE-TRAMP and UNDEFINED-TRAMP routines should look like real
Lisp functions. Make it so. (This approach suggested by Alastair
Bridegwater.)
assembly/sparc/assem-rtns.lisp:
o Add dummy routines to force aligment of CLOSURE-TRAMP and
UNDEFINED-TRAMP on the right boundary for a Lisp function.
o Modify CLOSURE-TRAMP and UNDEFINED-TRAMP to include the appropriate
function header words. We don't fill the self pointer correctly,
but that should be ok for these routines.
o Make these 4 routines assembly routines; no vops needed.
compiler/sparc/alloc.lisp:
compiler/sparc/cell.lisp:
o Remove code to used to fake out the function pointer stuff for
closure-tramp and undefined-tramp.
--------------------------------+
assembly/sparc/assem-rtns.lisp | 51 +++++++++++++++++++++++++++++++++++----
compiler/sparc/alloc.lisp | 4 ---
compiler/sparc/cell.lisp | 11 +-------
3 files changed, 49 insertions(+), 17 deletions(-)
Index: src/assembly/sparc/assem-rtns.lisp
diff -u src/assembly/sparc/assem-rtns.lisp:1.4.42.1 src/assembly/sparc/assem-rtns.lisp:1.4.42.2
--- src/assembly/sparc/assem-rtns.lisp:1.4.42.1 Fri Jul 16 21:19:01 2010
+++ src/assembly/sparc/assem-rtns.lisp Sat Jul 17 09:39:30 2010
@@ -5,11 +5,11 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/assembly/sparc/assem-rtns.lisp,v 1.4.42.1 2010-07-17 01:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/assembly/sparc/assem-rtns.lisp,v 1.4.42.2 2010-07-17 13:39:30 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
-;;; $Header: /project/cmucl/cvsroot/src/assembly/sparc/assem-rtns.lisp,v 1.4.42.1 2010-07-17 01:19:01 rtoy Exp $
+;;; $Header: /project/cmucl/cvsroot/src/assembly/sparc/assem-rtns.lisp,v 1.4.42.2 2010-07-17 13:39:30 rtoy Exp $
;;;
;;;
(in-package "SPARC")
@@ -239,17 +239,37 @@
(move target catch)
(inst li temp (make-fixup 'unwind :assembly-routine))
(inst j temp)
- (inst nop)
- ;; Make sure following routine is dual-word aligned
- (align vm:lowtag-bits))
+ (inst nop))
;; Assembly routines for undefined_tramp and closure_tramp
+
+#+assembler
+(define-assembly-routine (closure-tramp-function-alignment
+ (:return-style :none))
+ ()
+ ;; Align to a dualword and put in the magic function header stuff so
+ ;; that closure-tramp looks like a normal function with a function
+ ;; tag.
+ (align vm:lowtag-bits)
+ (inst byte 0))
+
+#+assembler
(define-assembly-routine (closure-tramp
(:return-style :none))
()
+ (inst byte 0)
+ (inst byte 0)
+ (inst byte vm:function-header-type)
+ ;; This is supposed to be closure-tramp, not 0.
+ (inst word 0)
+ (inst word (kernel:get-lisp-obj-address nil))
+ (inst word (kernel:get-lisp-obj-address nil))
+ (inst word (kernel:get-lisp-obj-address nil))
+ (inst word (kernel:get-lisp-obj-address nil))
+
(loadw lexenv-tn cname-tn fdefn-function-slot other-pointer-type)
(loadw code-tn lexenv-tn closure-function-slot function-pointer-type)
(inst j code-tn (- (* function-code-offset word-bytes) function-pointer-type))
@@ -257,9 +277,30 @@
;; Make sure following routine is dual-word aligned
(align vm:lowtag-bits))
+#+assembler
+(define-assembly-routine (undefined-tramp-function-alignment
+ (:return-style :none))
+ ()
+ ;; Align to a dualword and put in the magic function header stuff so
+ ;; that closure-tramp looks like a normal function with a function
+ ;; tag.
+ (align vm:lowtag-bits)
+ (inst byte 0))
+
+#+assembler
(define-assembly-routine (undefined-tramp
(:return-style :none))
()
+ (inst byte 0)
+ (inst byte 0)
+ (inst byte vm:function-header-type)
+ ;; This is supposed to be undefined-tramp, not 0.
+ (inst word 0)
+ (inst word (kernel:get-lisp-obj-address nil))
+ (inst word (kernel:get-lisp-obj-address nil))
+ (inst word (kernel:get-lisp-obj-address nil))
+ (inst word (kernel:get-lisp-obj-address nil))
+
(let ((error (generate-cerror-code nil undefined-symbol-error cname-tn)))
(inst b error)
(inst nop)
Index: src/compiler/sparc/alloc.lisp
diff -u src/compiler/sparc/alloc.lisp:1.24.2.1 src/compiler/sparc/alloc.lisp:1.24.2.2
--- src/compiler/sparc/alloc.lisp:1.24.2.1 Fri Jul 16 21:19:02 2010
+++ src/compiler/sparc/alloc.lisp Sat Jul 17 09:39:30 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/sparc/alloc.lisp,v 1.24.2.1 2010-07-17 01:19:02 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/sparc/alloc.lisp,v 1.24.2.2 2010-07-17 13:39:30 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -166,8 +166,6 @@
;; the address directly.
(inst li temp (make-fixup 'undefined-tramp
:assembly-routine))
- (inst sub temp (- (* vm:function-code-offset vm:word-bytes)
- function-pointer-type))
(storew name result fdefn-name-slot other-pointer-type)
(storew null-tn result fdefn-function-slot other-pointer-type)
(storew temp result fdefn-raw-addr-slot other-pointer-type))))
Index: src/compiler/sparc/cell.lisp
diff -u src/compiler/sparc/cell.lisp:1.27.2.1 src/compiler/sparc/cell.lisp:1.27.2.2
--- src/compiler/sparc/cell.lisp:1.27.2.1 Fri Jul 16 21:19:02 2010
+++ src/compiler/sparc/cell.lisp Sat Jul 17 09:39:30 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/sparc/cell.lisp,v 1.27.2.1 2010-07-17 01:19:02 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/sparc/cell.lisp,v 1.27.2.2 2010-07-17 13:39:30 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -172,13 +172,8 @@
(inst cmp type function-header-type)
(inst b :eq normal-fn)
(inst move lip function)
- (inst li temp (make-fixup 'closure-tramp
+ (inst li lip (make-fixup 'closure-tramp
:assembly-routine))
- ;; Since closure-tramp is an assembly routine, it doesn't look
- ;; like a normal Lisp function. So before we store it in the
- ;; raw addr slot, we need to make it look like a Lisp function.
- (inst sub lip temp (- (* vm:function-code-offset vm:word-bytes)
- function-pointer-type))
(emit-label normal-fn)
(storew function fdefn fdefn-function-slot other-pointer-type)
(storew lip fdefn fdefn-raw-addr-slot other-pointer-type)
@@ -213,8 +208,6 @@
(storew null-tn fdefn fdefn-function-slot other-pointer-type)
(inst li temp (make-fixup 'undefined-tramp
:assembly-routine))
- (inst sub temp (- (* vm:function-code-offset vm:word-bytes)
- function-pointer-type))
(storew temp fdefn fdefn-raw-addr-slot other-pointer-type)
(move result fdefn)))
More information about the cmucl-commit
mailing list