CMUCL commit: sparc-tramp-assem-branch src (5 files)
Raymond Toy
rtoy at common-lisp.net
Sat Jul 17 03:19:08 CEST 2010
Date: Friday, July 16, 2010 @ 21:19:06
Author: rtoy
Path: /project/cmucl/cvsroot/src
Tag: sparc-tramp-assem-branch
Modified: assembly/sparc/assem-rtns.lisp compiler/generic/new-genesis.lisp
compiler/sparc/alloc.lisp compiler/sparc/cell.lisp
compiler/sparc/vm.lisp
Move the undefined_tramp and closure_tramp routines into Lisp assembly
routines. This is based on an idea/code from Alastair Bridgewater.
More work needed, but the Lisp side appears to be working.
Needs to be cross-compiled and cross-sparc-sparc.lisp can be used.
But the compiling lisp needs to be 2010-08 (or 2010-07 from the
sparc-tramp-assem-branch.)
assembly/sparc/assem-rtns.lisp:
o Define assembly routines for UNDEFINED-TRAMP and CLOSURE-TRAMP.
compiler/generic/new-genesis.lisp:
o Adjust LOOKUP-SPECIAL-SYMBOL to look up "undefined_tramp" and
"closure_tramp" as assembly routines instead of foreign symbols.
o Don't need to register "undefined_tramp" and "closure_tramp" in the
linkage table anymore.
o In genesis, need to load the assem files before we initialize the
static functions.
compiler/sparc/alloc.lisp:
o Update make-fdefn to use undefined-tramp.
compiler/sparc/cell.lisp:
o Update set-fdefn-function to use closure-tramp.
o Update fdefn-makunbound to use undefined-tramp.
compiler/sparc/vm.lisp:
o Define lexenv-tn and cname-tn.
-----------------------------------+
assembly/sparc/assem-rtns.lisp | 32 ++++++++++++++++++++++---
compiler/generic/new-genesis.lisp | 28 +++++++++++++++++++++
compiler/sparc/alloc.lisp | 22 ++++++++++++++++-
compiler/sparc/cell.lisp | 46 +++++++++++++++++++++++++++++++++++-
compiler/sparc/vm.lisp | 4 ++-
5 files changed, 125 insertions(+), 7 deletions(-)
Index: src/assembly/sparc/assem-rtns.lisp
diff -u src/assembly/sparc/assem-rtns.lisp:1.4 src/assembly/sparc/assem-rtns.lisp:1.4.42.1
--- src/assembly/sparc/assem-rtns.lisp:1.4 Fri Feb 11 16:02:32 2005
+++ src/assembly/sparc/assem-rtns.lisp Fri Jul 16 21:19:01 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 2005-02-11 21:02:32 rtoy Rel $")
+ "$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 2005-02-11 21:02:32 rtoy Rel $
+;;; $Header: /project/cmucl/cvsroot/src/assembly/sparc/assem-rtns.lisp,v 1.4.42.1 2010-07-17 01:19:01 rtoy Exp $
;;;
;;;
(in-package "SPARC")
@@ -239,6 +239,32 @@
(move target catch)
(inst li temp (make-fixup 'unwind :assembly-routine))
(inst j temp)
- (inst nop))
+ (inst nop)
+ ;; Make sure following routine is dual-word aligned
+ (align vm:lowtag-bits))
+
+
+;; Assembly routines for undefined_tramp and closure_tramp
+(define-assembly-routine (closure-tramp
+ (:return-style :none))
+ ()
+ (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))
+ (inst nop)
+ ;; Make sure following routine is dual-word aligned
+ (align vm:lowtag-bits))
+
+(define-assembly-routine (undefined-tramp
+ (:return-style :none))
+ ()
+ (let ((error (generate-cerror-code nil undefined-symbol-error cname-tn)))
+ (inst b error)
+ (inst nop)
+ ;; I don't think we ever return from the undefined-symbol-error
+ ;; handler, but the assembly code did this so we'll do it too.
+ (loadw code-tn cname-tn fdefn-raw-addr-slot other-pointer-type)
+ (inst j code-tn (- (* function-code-offset word-bytes) function-pointer-type))
+ (inst nop)))
Index: src/compiler/generic/new-genesis.lisp
diff -u src/compiler/generic/new-genesis.lisp:1.89 src/compiler/generic/new-genesis.lisp:1.89.2.1
--- src/compiler/generic/new-genesis.lisp:1.89 Fri Mar 19 11:19:01 2010
+++ src/compiler/generic/new-genesis.lisp Fri Jul 16 21:19:02 2010
@@ -4,7 +4,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.89 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.89.2.1 2010-07-17 01:19:02 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -2165,11 +2165,25 @@
;; running lisp. Why? Because new C code may have moved these
;; addresses so we need to use the right values. We get worldbuild
;; issues if we use the old values that don't match.
+#+nil
(defun lookup-special-symbol (name)
(or (gethash name *cold-foreign-symbol-table* nil)
(lookup-foreign-symbol (vm::extern-alien-name name)
#+(or sparc ppc) :data)))
+(defun lookup-special-symbol (name)
+ (cond
+ #+sparc
+ ((string= name "closure_tramp")
+ (lookup-assembler-reference 'vm::closure-tramp))
+ #+sparc
+ ((string= name "undefined_tramp")
+ (lookup-assembler-reference 'vm::undefined-tramp))
+ (t
+ (or (gethash name *cold-foreign-symbol-table* nil)
+ (lookup-foreign-symbol (vm::extern-alien-name name)
+ #+(or sparc ppc) :data)))))
+
(defvar *cold-linkage-table* (make-array 8192 :adjustable t :fill-pointer 0))
(defvar *cold-foreign-hash* (make-hash-table :test #'equal))
@@ -2193,7 +2207,9 @@
#+(or sparc ppc)
(progn
(cold-register-foreign-linkage (vm::extern-alien-name "call_into_c") :code)
+ #-sparc
(cold-register-foreign-linkage (vm::extern-alien-name "undefined_tramp") :data)
+ #-sparc
(cold-register-foreign-linkage (vm::extern-alien-name "closure_tramp") :data)
))
@@ -2725,6 +2741,16 @@
(initialize-symbols)
(initialize-layouts)
(setf *current-init-functions-cons* *nil-descriptor*)
+ ;; Load the assembler-routines now since they include
+ ;; undefined-tramp and closure-tramp. We need the former
+ ;; in order to initialize the static functions and we need
+ ;; the latter to be able to static fset closures.
+ (flet ((is-assemfile (x)
+ (string-equal "assem"
+ (pathname-type x))))
+ (dolist (file-name (remove-if-not #'is-assemfile file-list))
+ (write-line (namestring file-name))
+ (cold-load file-name)))
(initialize-static-fns)
(dolist (file (if (listp file-list)
file-list
Index: src/compiler/sparc/alloc.lisp
diff -u src/compiler/sparc/alloc.lisp:1.24 src/compiler/sparc/alloc.lisp:1.24.2.1
--- src/compiler/sparc/alloc.lisp:1.24 Fri Mar 19 11:19:01 2010
+++ src/compiler/sparc/alloc.lisp Fri Jul 16 21:19:02 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 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/sparc/alloc.lisp,v 1.24.2.1 2010-07-17 01:19:02 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -132,6 +132,7 @@
(storew null-tn result code-entry-points-slot other-pointer-type)
(storew null-tn result code-debug-info-slot other-pointer-type))))
+#+nil
(define-vop (make-fdefn)
(:args (name :scs (descriptor-reg) :to :eval))
(:temporary (:scs (non-descriptor-reg)) temp)
@@ -152,6 +153,25 @@
(storew null-tn result fdefn-function-slot other-pointer-type)
(storew temp result fdefn-raw-addr-slot other-pointer-type))))
+(define-vop (make-fdefn)
+ (:args (name :scs (descriptor-reg) :to :eval))
+ (:temporary (:scs (non-descriptor-reg)) temp)
+ (:results (result :scs (descriptor-reg) :from :argument))
+ (:policy :fast-safe)
+ (:translate make-fdefn)
+ (:generator 37
+ (with-fixed-allocation (result temp fdefn-type fdefn-size)
+ ;; For the linkage-table stuff, we need to look up the address
+ ;; of undefined_tramp from the linkage table instead of using
+ ;; 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))))
+
(define-vop (make-closure)
(:args (function :to :save :scs (descriptor-reg)))
Index: src/compiler/sparc/cell.lisp
diff -u src/compiler/sparc/cell.lisp:1.27 src/compiler/sparc/cell.lisp:1.27.2.1
--- src/compiler/sparc/cell.lisp:1.27 Fri Mar 19 11:19:01 2010
+++ src/compiler/sparc/cell.lisp Fri Jul 16 21:19:02 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 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/sparc/cell.lisp,v 1.27.2.1 2010-07-17 01:19:02 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -130,6 +130,7 @@
(inst b :eq err-lab))
(inst nop)))
+#+nil
(define-vop (set-fdefn-function)
(:policy :fast-safe)
(:translate (setf fdefn-function))
@@ -156,6 +157,34 @@
(storew lip fdefn fdefn-raw-addr-slot other-pointer-type)
(move result function))))
+(define-vop (set-fdefn-function)
+ (:policy :fast-safe)
+ (:translate (setf fdefn-function))
+ (:args (function :scs (descriptor-reg) :target result)
+ (fdefn :scs (descriptor-reg)))
+ (:temporary (:scs (interior-reg)) lip)
+ (:temporary (:scs (non-descriptor-reg)) type)
+ (:temporary (:scs (non-descriptor-reg)) temp)
+ (:results (result :scs (descriptor-reg)))
+ (:generator 38
+ (let ((normal-fn (gen-label)))
+ (load-type type function (- function-pointer-type))
+ (inst cmp type function-header-type)
+ (inst b :eq normal-fn)
+ (inst move lip function)
+ (inst li temp (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)
+ (move result function))))
+
+#+nil
(define-vop (fdefn-makunbound)
(:policy :fast-safe)
(:translate fdefn-makunbound)
@@ -174,6 +203,21 @@
(storew temp fdefn fdefn-raw-addr-slot other-pointer-type)
(move result fdefn)))
+(define-vop (fdefn-makunbound)
+ (:policy :fast-safe)
+ (:translate fdefn-makunbound)
+ (:args (fdefn :scs (descriptor-reg) :target result))
+ (:temporary (:scs (non-descriptor-reg)) temp)
+ (:results (result :scs (descriptor-reg)))
+ (:generator 38
+ (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)))
+
;;;; Binding and Unbinding.
Index: src/compiler/sparc/vm.lisp
diff -u src/compiler/sparc/vm.lisp:1.26 src/compiler/sparc/vm.lisp:1.26.30.1
--- src/compiler/sparc/vm.lisp:1.26 Fri Jun 30 14:41:32 2006
+++ src/compiler/sparc/vm.lisp Fri Jul 16 21:19:02 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/vm.lisp,v 1.26 2006-06-30 18:41:32 rtoy Rel $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/sparc/vm.lisp,v 1.26.30.1 2010-07-17 01:19:02 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -387,6 +387,8 @@
(defregtn nsp any-reg)
(defregtn gtemp any-reg)
+(defregtn lexenv descriptor-reg)
+(defregtn cname descriptor-reg)
;;; Immediate-Constant-SC -- Interface
More information about the cmucl-commit
mailing list