CMUCL commit: sparc-tramp-assem-branch src (4 files)

[Raymond Toy]

    Date: Sunday, July 18, 2010 @ 16:03:15
  Author: rtoy
    Path: /project/cmucl/cvsroot/src
     Tag: sparc-tramp-assem-branch

Modified: assembly/x86/assem-rtns.lisp compiler/generic/new-genesis.lisp
          compiler/x86/alloc.lisp compiler/x86/cell.lisp

Change closure_tramp and undefined_tramp to Lisp assembly routines.

assembly/x86/assem-rtns.lisp:
o Define assembly routines for closure-tramp and undefined-tramp.

compiler/generic/new-genesis.lisp:
o LOOKUP-SPECIAL-SYMBOL needs to specialized for x86/amd64 too to
  lookup the assembly routines instead of foreign symbols.

compiler/x86/alloc.lisp:
o Update MAKE-FDEFN to use the undefined-tramp assembly routine.

compiler/x86/cell.lisp:
o Update SET-FDEFN-FUNCTION to use the closure-tramp assembly routine.
o Update FDEFN-MAKUNBOUND to use the undefind-tramp assembly routine.


-----------------------------------+
 assembly/x86/assem-rtns.lisp      |   22 ++++++++++++++++++++-
 compiler/generic/new-genesis.lisp |    6 ++---
 compiler/x86/alloc.lisp           |   16 ++++++++++++++-
 compiler/x86/cell.lisp            |   37 +++++++++++++++++++++++++++++++++++-
 4 files changed, 75 insertions(+), 6 deletions(-)


Index: src/assembly/x86/assem-rtns.lisp
diff -u src/assembly/x86/assem-rtns.lisp:1.8 src/assembly/x86/assem-rtns.lisp:1.8.16.1
--- src/assembly/x86/assem-rtns.lisp:1.8	Thu Jun 11 12:03:56 2009
+++ src/assembly/x86/assem-rtns.lisp	Sun Jul 18 16:03:04 2010
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group at cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/assembly/x86/assem-rtns.lisp,v 1.8 2009-06-11 16:03:56 rtoy Rel $")
+ "$Header: /project/cmucl/cvsroot/src/assembly/x86/assem-rtns.lisp,v 1.8.16.1 2010-07-18 20:03:04 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;; 
@@ -274,3 +274,23 @@
 
   (inst jmp (make-ea :byte :base block
 		     :disp (* unwind-block-entry-pc-slot word-bytes))))
+
+#+assembler
+(define-assembly-routine (closure-tramp
+			  (:return-style :none))
+                         ()
+  (loadw eax-tn eax-tn fdefn-function-slot other-pointer-type)
+  (inst jmp (make-ea :dword :base eax-tn
+		     :disp (- (* closure-function-slot word-bytes)
+			      function-pointer-type))))
+
+#+assembler
+(define-assembly-routine (undefined-tramp
+			  (:return-style :none))
+                         ()
+  (let ((error (generate-error-code nil undefined-symbol-error
+				    (make-random-tn :kind :normal
+						    :sc (sc-or-lose 'descriptor-reg c::*backend*)
+						    :offset 0))))
+    (inst jmp error)
+    (inst ret)))
Index: src/compiler/generic/new-genesis.lisp
diff -u src/compiler/generic/new-genesis.lisp:1.89.2.2 src/compiler/generic/new-genesis.lisp:1.89.2.3
--- src/compiler/generic/new-genesis.lisp:1.89.2.2	Sat Jul 17 11:43:44 2010
+++ src/compiler/generic/new-genesis.lisp	Sun Jul 18 16:03:04 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.2.2 2010-07-17 15:43:44 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.89.2.3 2010-07-18 20:03:04 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2173,10 +2173,10 @@
 
 (defun lookup-special-symbol (name)
   (cond
-    #+sparc
+    #+(or sparc x86 amd64)
     ((string= name "closure_tramp")
      (lookup-assembler-reference 'vm::closure-tramp))
-    #+sparc
+    #+(or sparc x86 amd64)
     ((string= name "undefined_tramp")
      (lookup-assembler-reference 'vm::undefined-tramp))
     (t
Index: src/compiler/x86/alloc.lisp
diff -u src/compiler/x86/alloc.lisp:1.14 src/compiler/x86/alloc.lisp:1.14.2.1
--- src/compiler/x86/alloc.lisp:1.14	Fri Mar 19 11:19:01 2010
+++ src/compiler/x86/alloc.lisp	Sun Jul 18 16:03:04 2010
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group at cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/x86/alloc.lisp,v 1.14 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/x86/alloc.lisp,v 1.14.2.1 2010-07-18 20:03:04 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -162,6 +162,7 @@
     (storew nil-value result code-debug-info-slot other-pointer-type)))
 
 
+#+nil
 (define-vop (make-fdefn)
   (:policy :fast-safe)
   (:translate make-fdefn)
@@ -175,6 +176,19 @@
       (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign)
 	      result fdefn-raw-addr-slot other-pointer-type))))
 
+(define-vop (make-fdefn)
+  (:policy :fast-safe)
+  (:translate make-fdefn)
+  (:args (name :scs (descriptor-reg) :to :eval))
+  (:results (result :scs (descriptor-reg) :from :argument))
+  (:node-var node)
+  (:generator 37
+    (with-fixed-allocation (result fdefn-type fdefn-size node)
+      (storew name result fdefn-name-slot other-pointer-type)
+      (storew nil-value result fdefn-function-slot other-pointer-type)
+      (storew (make-fixup 'undefined-tramp :assembly-routine)
+	      result fdefn-raw-addr-slot other-pointer-type))))
+
 
 (define-vop (make-closure)
   (:args (function :to :save :scs (descriptor-reg)))
Index: src/compiler/x86/cell.lisp
diff -u src/compiler/x86/cell.lisp:1.16 src/compiler/x86/cell.lisp:1.16.2.1
--- src/compiler/x86/cell.lisp:1.16	Fri Mar 19 11:19:01 2010
+++ src/compiler/x86/cell.lisp	Sun Jul 18 16:03:04 2010
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group at cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/x86/cell.lisp,v 1.16 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/x86/cell.lisp,v 1.16.2.1 2010-07-18 20:03:04 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -169,6 +169,7 @@
     (let ((err-lab (generate-error-code vop undefined-symbol-error object)))
       (inst jmp :e err-lab))))
 
+#+nil
 (define-vop (set-fdefn-function)
   (:policy :fast-safe)
   (:translate (setf fdefn-function))
@@ -191,6 +192,29 @@
     (storew raw 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 (:sc unsigned-reg) raw)
+  (:temporary (:sc byte-reg) type)
+  (:results (result :scs (descriptor-reg)))
+  (:generator 38
+    (load-type type function (- function-pointer-type))
+    (inst lea raw
+	  (make-ea :byte :base function
+		   :disp (- (* function-code-offset word-bytes)
+			    function-pointer-type)))
+    (inst cmp type function-header-type)
+    (inst jmp :e normal-fn)
+    (inst lea raw (make-fixup 'closure-tramp :assembly-routine))
+    NORMAL-FN
+    (storew function fdefn fdefn-function-slot other-pointer-type)
+    (storew raw fdefn fdefn-raw-addr-slot other-pointer-type)
+    (move result function)))
+
+#+nil
 (define-vop (fdefn-makunbound)
   (:policy :fast-safe)
   (:translate fdefn-makunbound)
@@ -202,6 +226,17 @@
 	    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))
+  (:results (result :scs (descriptor-reg)))
+  (:generator 38
+    (storew nil-value fdefn fdefn-function-slot other-pointer-type)
+    (storew (make-fixup 'undefined-tramp :assembly-routine)
+	    fdefn fdefn-raw-addr-slot other-pointer-type)
+    (move result fdefn)))
+
 
 
 ;;;; Binding and Unbinding.