Index: /trunk/ccl/level-0/X86/x86-def.lisp
===================================================================
--- /trunk/ccl/level-0/X86/x86-def.lisp	(revision 6477)
+++ /trunk/ccl/level-0/X86/x86-def.lisp	(revision 6478)
@@ -92,5 +92,4 @@
   (jmp-subprim .SPvalues))
   
-
         
 
@@ -156,4 +155,5 @@
 
 (defx86lapfunction %fixnum-ref ((fixnum arg_y) #| &optional |# (offset arg_z))
+  (:arglist (fixnum &optional offset))
   (check-nargs 1 2)
   (cmpw ($ x8664::fixnumone) (% nargs))
@@ -167,4 +167,5 @@
 
 (defx86lapfunction %fixnum-ref-natural ((fixnum arg_y) #| &optional |# (offset arg_z))
+  (:arglist (fixnum &optional offset))
   (check-nargs 1 2)
   (cmpw ($ x8664::fixnumone) (% nargs))
@@ -178,4 +179,5 @@
 
 (defx86lapfunction %fixnum-set ((fixnum arg_x) (offset arg_y) #| &optional |# (new-value arg_z))
+  (:arglist (fixnum offset &optional newval))
   (check-nargs 2 3)
   (cmpw ($ '2) (% nargs))
@@ -190,6 +192,6 @@
 
 
-
 (defx86lapfunction %fixnum-set-natural ((fixnum arg_x) (offset arg_y) #| &optional |# (new-value arg_z))
+  (:arglist (fixnum offset &optional newval))
   (check-nargs 2 3)
   (save-simple-frame)
@@ -223,13 +225,18 @@
   (single-value-return))
 
-
+;;; Look for "lea -nnnn(%rip),%fn" AT the tra; if that's present, use
+;;; the dispacement -nnnn to find the function.  The end of the
+;;; encoded displacement is
+;;; x8664::recover-fn-from-rip-disp-offset (= 7) bytes from the tra.
 (defx86lapfunction %return-address-function ((r arg_z))
   (extract-lisptag r imm0)
   (cmpb ($ x8664::tag-tra) (% imm0.b))
   (jne @fail)
-  (movl (@ -4 (% r)) (% imm0.l))
-  (testl (% imm0.l) (% imm0.l))
-  (jle @fail)
-  (subq (% imm0) (% arg_z))
+  (cmpw ($ x8664::recover-fn-from-rip-word0) (@ (% r)))
+  (jne @fail)
+  (cmpb ($ x8664::recover-fn-from-rip-byte2) (@ 2 (% r)))
+  (movslq (@ x8664::recover-fn-from-rip-disp-offset (% r)) (% imm0))
+  (jne @fail)
+  (lea (@ x8664::recover-fn-from-rip-length (% imm0) (% r)) (% arg_z))
   (single-value-return)
   @fail
@@ -241,8 +248,11 @@
   (cmpb ($ x8664::tag-tra) (% imm0.b))
   (jne @fail)
-  (movl (@ -4 (% r)) (% imm0.l))
-  (testl (% imm0.l) (% imm0.l))
-  (jle @fail)
-  (box-fixnum imm0 arg_z)
+  (cmpw ($ x8664::recover-fn-from-rip-word0) (@ (% r)))
+  (jne @fail)
+  (cmpb ($ x8664::recover-fn-from-rip-byte2) (@ 2 (% r)))
+  (movslq (@ x8664::recover-fn-from-rip-disp-offset (% r)) (% imm0))
+  (jne @fail)
+  (negq (% imm0))
+  (leaq (@ (ash x8664::recover-fn-from-rip-length x8664::fixnumshift) (% imm0) 8) (% arg_z))
   (single-value-return)
   @fail
@@ -252,28 +262,9 @@
 ;;; It's always been the case that the function associated with a
 ;;; frame pointer is the caller of the function that "uses" that frame.
-(defx86lapfunction %cfp-lfun ((p arg_z))
-  (ref-global ret1valaddr imm0)
-  (movq (@ x8664::lisp-frame.return-address (% p)) (% arg_y))
-  (cmpq (% imm0) (% arg_y))
-  (cmoveq (@ x8664::lisp-frame.xtra (% p)) (% arg_y))
-  (extract-lisptag arg_y imm0)
-  (cmpb ($ x8664::tag-tra) (%b imm0))
-  (jne @no)
-  (movl (@ -4 (% arg_y)) (%l imm0))
-  (testl (% imm0.l) (% imm0.l))
-  (je @no)
-  (subq (% imm0) (% arg_y))
-  (box-fixnum imm0 arg_z)
-  (movq (% rsp) (% temp0))
-  (pushq (% arg_y))
-  (pushq (% arg_z))
-  (set-nargs 2)
-  (jmp-subprim .SPvalues)
-  @no
-  (movq (% rsp) (% temp0))
-  (pushq ($ x8664::nil-value))
-  (pushq ($ x8664::nil-value))
-  (set-nargs 2)
-  (jmp-subprim .SPvalues))
+(defun %cfp-lfun (p)
+  (let* ((ra (%fixnum-ref p x8664::lisp-frame.return-address)))
+    (if (eq ra (%get-kernel-global ret1valaddr))
+      (setq ra (%fixnum-ref p x8664::lisp-frame.xtra)))
+    (values (%return-address-function ra) (%return-address-offset ra))))
 
 
@@ -350,4 +341,5 @@
   ;;   but preserves x866::xfn/x8664::next-method-context.
   ;; Jump to the function in x8664::xfn.
+  (popq (% ra0))
   (movq (% magic) (% next-method-context))
   (movq (% function) (% xfn))
@@ -381,6 +373,6 @@
   (jmp @three)
   @go
-  (xchgq (% xfn) (% fn))
-  (jmp (% fn)))
+  (push (% ra0))
+  (jmp (% xfn)))
 
 (defx86lapfunction %apply-with-method-context ((magic arg_x)
@@ -393,6 +385,5 @@
   ;;   but preserves x8664::xfn/x8664::next-method-context.
   ;; Jump to the function in x8664::xfn.
-  ;; We need to inline the "spreadargz" operation, 'cause there's no
-  ;; good place to keep %ra0.
+  (pop (% ra0))  
   (movq (% magic) (% x8664::next-method-context))
   (movq (% function) (% x8664::xfn))
@@ -431,6 +422,6 @@
   (je @discard-and-go)
   @go
-  (xchgq (% xfn) (% fn))
-  (jmp (% fn))
+  (push (% ra0))
+  (jmp (% xfn))
   @bad
   (addq (% imm0) (% rsp))
@@ -447,4 +438,5 @@
 ;;; entry must be in %rbp.
 (defx86lapfunction %apply-lexpr-tail-wise ((method arg_y) (args arg_z))
+  (addq ($ x8664::node-size) (% rsp))   ; discard extra return address
   (movq (% method) (% xfn))
   (movq (% args) (% rsp))
@@ -478,6 +470,6 @@
   (discard-reserved-frame)
   @popped
-  (xchgq (% xfn) (% fn))
-  (jmp (% fn)))
+  (push (% ra0))
+  (jmp (% xfn)))
 
 
@@ -495,6 +487,8 @@
 (defun apply+ (&lap function arg1 arg2 &rest other-args)
   (x86-lap-function apply+ ()
+   (:arglist (function arg1 arg2 &rest other-args))
    (check-nargs 3 nil)
    (cmpw ($ '3) (% nargs))
+   (pop (% ra0))
    (ja @no-frame)
    (pushq ($ x8664::reserved-frame-marker))
@@ -533,4 +527,5 @@
    @no-discard
    (load-constant funcall temp0)
+   (push (% ra0))
    (jmp-subprim .SPfuncall)
    @bad                                 ; error spreading list.
@@ -541,6 +536,5 @@
    (jmp-subprim .SPksignalerr) ))
 
-(lfun-bits #'apply+ (logior $lfbits-rest-bit
-                            (dpb 3 $lfbits-numreq 0)))
+
 
 ;;; This needs to:
@@ -551,6 +545,7 @@
 ;;;     (%rax/%xmm0) there
 (defx86lapfunction %do-ff-call ((nfp 0) (frame arg_x) (fp-regs arg_y) (entry arg_z))
+  (popq (% ra0))
   (popq (% rax))
-  (movq (% rbp) (@ @ (% rsp)))
+  (movq (% rbp) (@  (% rsp)))
   (movq (% rsp) (% rbp))
   (movq (% ra0) (@ 8 (% rbp)))
