From c76a1955abc773a8704c03942ea82ed04b919b6e Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Mon, 17 Sep 1990 23:44:18 +0000
Subject: [PATCH] Changed stuff necessary to make named-call more optimal.  Now
 symbols have an additional slot that holds the raw address of the function
 (i.e. the location to jump to).  Named-call just uses this value.

---
 assembly/assemfile.lisp      |   4 +-
 compiler/mips/alloc.lisp     |  25 ++--
 compiler/mips/call.lisp      | 217 +++++++++++++++++++++++------------
 compiler/mips/cell.lisp      |  21 +++-
 compiler/mips/insts.lisp     |   5 +-
 compiler/mips/parms.lisp     |  22 ++--
 compiler/mips/static-fn.lisp |  16 ++-
 7 files changed, 197 insertions(+), 113 deletions(-)

diff --git a/assembly/assemfile.lisp b/assembly/assemfile.lisp
index f017f8306..ec5faec98 100644
--- a/assembly/assemfile.lisp
+++ b/assembly/assemfile.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.13 1990/06/25 23:34:17 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.14 1990/09/17 23:43:45 wlott Exp $
 ;;;
 ;;; This file contains the extra code necessary to feed an entire file of
 ;;; assembly code to the assembler.
@@ -38,6 +38,7 @@
 	(let (*code-segment*
 	      *elsewhere*
 	      #-new-compiler (lisp::*in-compilation-unit* nil))
+	  (pushnew :assembler *features*)
 	  (init-assembler)
 	  (load (merge-pathnames name (make-pathname :type "lisp")))
 	  (fasl-dump-cold-load-form `(in-package ,(package-name *package*))
@@ -60,6 +61,7 @@
 	      (dump-segment *code-segment* file)
 	      (fresh-line file)))
 	  (setq won t))
+      (deletef :assembler *features*)
       (close-fasl-file *lap-output-file* (not won)))
     won))
 
diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp
index 03c842e76..c4adb427c 100644
--- a/compiler/mips/alloc.lisp
+++ b/compiler/mips/alloc.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.10 1990/07/16 17:40:10 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.11 1990/09/17 23:42:28 wlott Exp $
 ;;;
 ;;; Allocation VOPs for the MIPS port.
 ;;;
@@ -105,28 +105,23 @@
       (storew null-tn result vm:code-debug-info-slot vm:other-pointer-type))))
 
 (define-vop (make-symbol)
-  (:args (name :scs (descriptor-reg)))
-  (:temporary (:scs (non-descriptor-reg) :type random) ndescr temp)
-  (:temporary (:scs (descriptor-reg) :to (:result 0) :target real-result)
-	      result)
-  (:results (real-result :scs (descriptor-reg)))
+  (: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-symbol)
   (:generator 37
-    (pseudo-atomic (ndescr)
-      (inst addu result alloc-tn vm:other-pointer-type)
-      (inst addu alloc-tn alloc-tn (pad-data-block vm:symbol-size))
-      (inst li temp (logior (ash (1- vm:symbol-size) vm:type-bits)
-			    vm:symbol-header-type))
-      (storew temp result 0 vm:other-pointer-type)
+    (with-fixed-allocation (result temp vm:symbol-header-type vm:symbol-size)
       (inst li temp vm:unbound-marker-type)
       (storew temp result vm:symbol-value-slot vm:other-pointer-type)
-      (load-symbol-value temp lisp::*the-undefined-function*)
       (storew temp result vm:symbol-function-slot vm:other-pointer-type)
+      (storew temp result vm:symbol-setf-function-slot vm:other-pointer-type)
+      (inst li temp (make-fixup 'undefined-function :assembly-routine))
+      (storew temp result vm:symbol-raw-function-addr-slot
+	      vm:other-pointer-type)
       (storew null-tn result vm:symbol-plist-slot vm:other-pointer-type)
       (storew name result vm:symbol-name-slot vm:other-pointer-type)
-      (storew null-tn result vm:symbol-package-slot vm:other-pointer-type)
-      (move real-result result))))
+      (storew null-tn result vm:symbol-package-slot vm:other-pointer-type))))
 
 
 ;;;; Automatic allocators for primitive objects.
diff --git a/compiler/mips/call.lisp b/compiler/mips/call.lisp
index 8c10cacef..6ed778541 100644
--- a/compiler/mips/call.lisp
+++ b/compiler/mips/call.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.28 1990/09/06 17:41:50 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.29 1990/09/17 23:43:48 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition of function call for the MIPS.
 ;;;
@@ -168,14 +168,19 @@
 (define-vop (xep-allocate-frame)
   (:info start-lab)
   (:vop-var vop)
+  (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 1
-    ;; Make sure the label is aligned.
+    ;; Make sure the function is aligned.
     (align vm:lowtag-bits)
-    (emit-label start-lab)
     ;; Allocate function header.
     (inst function-header-word)
     (dotimes (i (1- vm:function-header-code-offset))
       (inst word 0))
+    ;; The start of the actual code.
+    (emit-label start-lab)
+    ;; Fix CODE, cause the function object was passed in.
+    (inst compute-code-from-fn code-tn lip-tn start-lab temp)
+    ;; Build our stack frames.
     (inst addu csp-tn fp-tn
 	  (* vm:word-bytes (sb-allocated-size 'control-stack)))
     (let ((nfp-tn (current-nfp-tn vop)))
@@ -431,7 +436,7 @@ default-value-5
   (:save-p t)
   (:move-args :local-call)
   (:info arg-locs callee target nvals)
-  (:ignore arg-locs args nfp)
+  (:ignore arg-locs args)
   (:vop-var vop)
   (:temporary (:scs (descriptor-reg)) move-temp)
   (:temporary (:scs (non-descriptor-reg)) temp)
@@ -617,12 +622,12 @@ default-value-5
 	  '((new-fp :scs (any-reg) :to :eval)))
 
       ,(if named
-	   '(name :scs (descriptor-reg) :target name-pass)
-	   '(arg-fun :scs (descriptor-reg) :target lexenv :to :eval))
+	   '(name :target name-pass)
+	   '(arg-fun :target lexenv))
       
       ,@(when (eq return :tail)
-	  '((old-fp :scs (any-reg) :target old-fp-pass)
-	    (return-pc :scs (descriptor-reg) :target return-pc-pass)))
+	  '((old-fp :target old-fp-pass)
+	    (return-pc :target return-pc-pass)))
       
       ,@(unless variable '((args :more t))))
 
@@ -655,20 +660,20 @@ default-value-5
 		  :to :eval)
 		 return-pc-pass)
 
-     ,@(when named 
+     ,@(if named
 	 `((:temporary (:sc descriptor-reg :offset cname-offset
 			:from (:argument ,(if (eq return :tail) 0 1))
 			:to :eval)
-		       name-pass)))
-
-     (:temporary (:sc descriptor-reg :offset lexenv-offset
-		  :from (:argument ,(if (eq return :tail) 0 1)) :to :eval)
-		 lexenv)
+		       name-pass))
 
-     (:temporary (:scs (descriptor-reg) :from (:argument 0) :to :eval)
-		 function)
+	 `((:temporary (:sc descriptor-reg :offset lexenv-offset
+			:from (:argument ,(if (eq return :tail) 0 1))
+			:to :eval)
+		       lexenv)
+	   (:temporary (:scs (descriptor-reg) :from (:argument 0) :to :eval)
+		       function)))
 
-     (:temporary (:sc descriptor-reg :offset nargs-offset :to :eval)
+     (:temporary (:sc any-reg :offset nargs-offset :to :eval)
 		 nargs-pass)
 
      ,@(when variable
@@ -692,62 +697,130 @@ default-value-5
 		     (if (eq return :tail) 0 10)
 		     15
 		     (if (eq return :unknown) 25 0))
-       
-       ,@(if named
-	     `((move name-pass name)
-	       (loadw lexenv name-pass
-		      vm:symbol-function-slot vm:other-pointer-type))
-	     `((move lexenv arg-fun)))
-       
-       ,@(if variable
-	     `((inst subu nargs-pass csp-tn new-fp)
-	       ,@(let ((index -1))
-		   (mapcar #'(lambda (name)
-			       `(loadw ,name new-fp ,(incf index)))
-			   register-arg-names)))
-	     `((inst li nargs-pass (fixnum nargs))))
-       
-       (let ((cur-nfp (current-nfp-tn vop))
-	     ,@(unless (eq return :tail)
-		 '((lra-label (gen-label)))))
-	 ,@(unless (eq return :tail)
-	     `((inst compute-lra-from-code
-		     return-pc-pass code-tn lra-label temp)))
-
-	 (loadw function lexenv vm:closure-function-slot
-		vm:function-pointer-type)
-	 (inst addu lip function (- (ash vm:function-header-code-offset
-					 vm:word-shift)
-				    vm:function-pointer-type))
-
-	 ,@(if (eq return :tail)
-	       '((move old-fp-pass old-fp)
-		 (move return-pc-pass return-pc)
-		 (when cur-nfp
-		   (inst addu nsp-tn cur-nfp
-			 (bytes-needed-for-non-descriptor-stack-frame)))
-		 (inst j lip)
-		 (move code-tn function))
-	       `((move old-fp-pass fp-tn)
-		 (when cur-nfp
-		   (store-stack-tn nfp-save cur-nfp))
-		 ,(if variable
-		      '(move fp-tn new-fp)
-		      '(if (> nargs register-arg-count)
-			   (move fp-tn new-fp)
-			   (move fp-tn csp-tn)))
-		 (inst j lip)
-		 (move code-tn function)
-		 (emit-return-pc lra-label)))
+       (let* ((cur-nfp (current-nfp-tn vop))
+	      ,@(unless (eq return :tail)
+		  '((lra-label (gen-label))))
+	      (filler
+	       (remove nil
+		       (list :load-nargs
+			     ,@(if (eq return :tail)
+				   '((unless (location= old-fp old-fp-pass)
+				       :load-old-fp)
+				     (unless (location= return-pc
+							return-pc-pass)
+				       :load-return-pc)
+				     (when cur-nfp
+				       :frob-nfp))
+				   '(:comp-lra
+				     (when cur-nfp
+				       :frob-nfp)
+				     :save-fp
+				     :load-fp))))))
+	 (flet ((do-next-filler ()
+		  (let* ((next (pop filler))
+			 (what (if (consp next) (car next) next)))
+		    (ecase what
+		      (:load-nargs
+		       ,@(if variable
+			     `((inst subu nargs-pass csp-tn new-fp)
+			       ,@(let ((index -1))
+				   (mapcar #'(lambda (name)
+					       `(inst lw ,name new-fp
+						      ,(ash (incf index)
+							    vm:word-shift)))
+					   register-arg-names)))
+			     '((inst li nargs-pass (fixnum nargs)))))
+		      ,@(if (eq return :tail)
+			    '((:load-old-fp
+			       (sc-case old-fp
+				 (any-reg
+				  (inst move old-fp-pass old-fp))
+				 (control-stack
+				  (inst lw old-fp-pass fp-tn
+					(ash (tn-offset old-fp)
+					     vm:word-shift)))))
+			      (:load-return-pc
+			       (sc-case return-pc
+				 (any-reg
+				  (inst move return-pc-pass return-pc))
+				 (control-stack
+				  (inst lw return-pc-pass fp-tn
+					(ash (tn-offset return-pc)
+					     vm:word-shift)))))
+			      (:frob-nfp
+			       (inst addu nsp-tn cur-nfp
+				     (bytes-needed-for-non-descriptor-stack-frame))))
+			    `((:comp-lra
+			       (inst compute-lra-from-code
+				     return-pc-pass code-tn lra-label temp))
+			      (:frob-nfp
+			       (store-stack-tn nfp-save cur-nfp))
+			      (:save-fp
+			       (inst move old-fp-pass fp-tn))
+			      (:load-fp
+			       ,(if variable
+				    '(move fp-tn new-fp)
+				    '(if (> nargs register-arg-count)
+					 (move fp-tn new-fp)
+					 (move fp-tn csp-tn))))))
+		      ((nil)
+		       (inst nop))))))
+
+	   ,@(if named
+		 `((sc-case name
+		     (descriptor-reg (move name-pass name))
+		     (control-stack
+		      (inst lw name-pass fp-tn
+			    (ash (tn-offset name) vm:word-shift))
+		      (do-next-filler))
+		     (constant
+		      (inst lw name-pass code-tn
+			    (- (ash (tn-offset name) vm:word-shift)
+			       vm:other-pointer-type))
+		      (do-next-filler)))
+		   (inst lw lip name-pass
+			 (- (ash vm:symbol-raw-function-addr-slot
+				 vm:word-shift)
+			    vm:other-pointer-type))
+		   (do-next-filler))
+		 `((sc-case arg-fun
+		     (descriptor-reg (move lexenv arg-fun))
+		     (control-stack
+		      (inst lw lexenv fp-tn
+			    (ash (tn-offset arg-fun) vm:word-shift))
+		      (do-next-filler))
+		     #+nil
+		     (constant
+		      (inst lw lexenv code-tn
+			    (- (ash (tn-offset arg-fun) vm:word-shift)
+			       vm:other-pointer-type))
+		      (do-next-filler)))
+		   (inst lw function lexenv
+			 (- (ash vm:closure-function-slot vm:word-shift)
+			    vm:function-pointer-type))
+		   (do-next-filler)
+		   (inst addu lip function
+			 (- (ash vm:function-header-code-offset
+				 vm:word-shift)
+			    vm:function-pointer-type))))
+	   (loop
+	     (if (cdr filler)
+		 (do-next-filler)
+		 (return)))
+	   
+	   (inst j lip)
+	   (do-next-filler))
 
 	 ,@(ecase return
 	     (:fixed
-	      '((note-this-location vop :unknown-return)
+	      '((emit-return-pc lra-label)
+		(note-this-location vop :unknown-return)
 		(default-unknown-values values nvals move-temp temp lra-label)
 		(when cur-nfp
 		  (load-stack-tn cur-nfp nfp-save))))
 	     (:unknown
-	      '((note-this-location vop :unknown-return)
+	      '((emit-return-pc lra-label)
+		(note-this-location vop :unknown-return)
 		(receive-unknown-values values-start nvals start count
 					lra-label temp)
 		(when cur-nfp
@@ -1029,10 +1102,10 @@ default-value-5
 ;;;
 (define-vop (setup-environment)
   (:info label)
-  (:temporary (:scs (non-descriptor-reg)) temp)
-  (:generator 5
-    ;; Fix CODE, cause the function object was passed in.
-    (inst compute-code-from-fn code-tn code-tn label temp)))
+  (:ignore label)
+  (:generator 0
+    ;; Don't bother doing anything.
+    ))
 
 ;;; Return the current Env as our result, then indirect throught the closure
 ;;; and the closure-entry to find the constant pool
@@ -1041,12 +1114,10 @@ default-value-5
   (:temporary (:sc descriptor-reg :offset lexenv-offset :target closure
 	       :to (:result 0))
 	      lexenv)
-  (:temporary (:scs (non-descriptor-reg)) temp)
   (:results (closure :scs (descriptor-reg)))
   (:info label)
+  (:ignore label)
   (:generator 6
-    ;; Fix CODE, cause the function object was passed in.
-    (inst compute-code-from-fn code-tn code-tn label temp)
     ;; Get result.
     (move closure lexenv)))
 
diff --git a/compiler/mips/cell.lisp b/compiler/mips/cell.lisp
index 58d6740a1..e05b53498 100644
--- a/compiler/mips/cell.lisp
+++ b/compiler/mips/cell.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.41 1990/08/15 02:55:52 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.42 1990/09/17 23:43:54 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition of various primitive memory access
 ;;; VOPs for the MIPS.
@@ -113,6 +113,15 @@
     (let ((err-lab (generate-error-code vop undefined-symbol-error obj-temp)))
       (test-simple-type value temp err-lab t vm:function-pointer-type))))
 
+#+nil
+(define-vop (symbol-setf-function checked-cell-ref)
+  (:translate symbol-setf-function)
+  (:generator 10
+    (move obj-temp object)
+    (loadw value obj-temp vm:symbol-setf-function-slot vm:other-pointer-type)
+    (let ((err-lab (generate-error-code vop undefined-symbol-error obj-temp)))
+      (test-simple-type value temp err-lab t vm:function-pointer-type))))
+
 
 ;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell is bound.
 (define-vop (boundp-frob)
@@ -148,6 +157,16 @@
     (loadw value object vm:symbol-function-slot vm:other-pointer-type)
     (test-simple-type value temp target not-p vm:function-pointer-type)))
 
+(defknown fboundp/setf (t) boolean (flushable))
+;;;
+(deftransform fboundp ((x) (cons))
+  '(foundp/setf (cadr x)))
+;;;
+(define-vop (fboundp/setf boundp-frob)
+  (:translate fboundp/setf)
+  (:generator 10
+    (loadw value object vm:symbol-setf-function-slot vm:other-pointer-type)
+    (test-simple-type value temp target not-p vm:function-pointer-type)))
 
 (define-vop (fast-symbol-value cell-ref)
   (:variant vm:symbol-value-slot vm:other-pointer-type)
diff --git a/compiler/mips/insts.lisp b/compiler/mips/insts.lisp
index a5479ea57..af094c65d 100644
--- a/compiler/mips/insts.lisp
+++ b/compiler/mips/insts.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.24 1990/08/21 19:12:18 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.25 1990/09/17 23:44:06 wlott Exp $
 ;;;
 ;;; Description of the MIPS architecture.
 ;;;
@@ -694,10 +694,9 @@
 		(inst addu dst src temp)))))))
 
 
-;; code = fn - fn-tag - header - label-offset + other-pointer-tag
+;; code = fn - header - label-offset + other-pointer-tag
 (define-compute-instruction compute-code-from-fn
 			    (- vm:other-pointer-type
-			       vm:function-pointer-type
 			       (label-position label)
 			       (component-header-length)))
 
diff --git a/compiler/mips/parms.lisp b/compiler/mips/parms.lisp
index 77f2067ad..4bb5d2d39 100644
--- a/compiler/mips/parms.lisp
+++ b/compiler/mips/parms.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/parms.lisp,v 1.69 1990/09/09 20:39:02 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/parms.lisp,v 1.70 1990/09/17 23:44:14 wlott Exp $
 ;;;
 ;;;    This file contains some parameterizations of various VM
 ;;; attributes for the MIPS.  This file is separate from other stuff so 
@@ -20,7 +20,7 @@
 
 (in-package "VM")
 
-(eval-when (compile load eval)
+;(eval-when (compile load eval)
 
 
 ;;;; Compiler constants.
@@ -458,6 +458,12 @@
 	 :setf-vop set)
   (function :setf-vop c::set-symbol-function
 	    :set-trans c::%sp-set-definition)
+  (raw-function-addr :c-type "char *"
+		     :ref-known (c::flushable)
+		     :ref-trans symbol-raw-function-addr
+		     :set-known (c::unsafe)
+		     :set-trans %set-symbol-raw-function-addr)
+  (setf-function)
   (plist :ref-trans symbol-plist
 	 :setf-vop c::set-symbol-plist
 	 :set-trans c::%sp-set-plist)
@@ -527,7 +533,6 @@
     lisp::*initial-symbols*
     lisp::*lisp-initialization-functions*
     lisp::%initial-function
-    lisp::*the-undefined-function*
 
     ;; Free Pointers
     lisp::*read-only-space-free-pointer*
@@ -541,16 +546,14 @@
 
     ;; Interrupt Handling
     lisp::*free-interrupt-context-index*
+    mach::*interrupts-enabled*
+    mach::*interrupt-pending*
 
     ;; Static functions.
     two-arg-+ two-arg-- two-arg-* two-arg-/ two-arg-< two-arg-> two-arg-=
     two-arg-<= two-arg->= two-arg-/= %negate
     two-arg-and two-arg-ior two-arg-xor
     length two-arg-gcd two-arg-lcm
-
-    ;; Stuff for without interrupts.  ### Should be with free-interrupt-context
-    ;; above, but we don't want to have to recompile everything just right now.
-    mach::*interrupts-enabled* mach::*interrupt-pending*
     ))
 
 (defparameter exported-static-symbols
@@ -562,7 +565,6 @@
     lisp::*initial-symbols*
     lisp::*lisp-initialization-functions*
     lisp::%initial-function
-    lisp::*the-undefined-function*
 
     ;; Free Pointers
     lisp::*read-only-space-free-pointer*
@@ -640,6 +642,4 @@
 (defparameter vm-version "DECstation 3100/Mach 0.0")
 
 
-
-
-); Eval-When (Compile Load Eval)
+;); Eval-When (Compile Load Eval)
diff --git a/compiler/mips/static-fn.lisp b/compiler/mips/static-fn.lisp
index dc2747084..f91ebded4 100644
--- a/compiler/mips/static-fn.lisp
+++ b/compiler/mips/static-fn.lisp
@@ -7,7 +7,7 @@
 ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/static-fn.lisp,v 1.11 1990/07/03 06:34:26 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/static-fn.lisp,v 1.12 1990/09/17 23:44:18 wlott Exp $
 ;;;
 ;;; This file contains the VOPs and macro magic necessary to call static
 ;;; functions.
@@ -27,8 +27,6 @@
   (:temporary (:scs (descriptor-reg)) move-temp)
   (:temporary (:sc descriptor-reg :offset lra-offset) lra)
   (:temporary (:sc descriptor-reg :offset cname-offset) cname)
-  (:temporary (:sc descriptor-reg :offset lexenv-offset) lexenv)
-  (:temporary (:scs (descriptor-reg)) function)
   (:temporary (:scs (interior-reg) :type interior) lip)
   (:temporary (:sc any-reg :offset nargs-offset) nargs)
   (:temporary (:sc any-reg :offset old-fp-offset) old-fp)
@@ -91,15 +89,15 @@
 	     ,@(moves (temp-names) (arg-names))
 	     (inst li nargs (fixnum ,num-args))
 	     (load-symbol cname symbol)
-	     (loadw lexenv cname vm:symbol-function-slot vm:other-pointer-type)
+	     (inst lw lip cname
+		   (- (ash vm:symbol-raw-function-addr-slot vm:word-shift)
+		      vm:other-pointer-type))
 	     (when cur-nfp
 	       (store-stack-tn nfp-save cur-nfp))
-	     (move old-fp fp-tn)
-	     (move fp-tn csp-tn)
+	     (inst move old-fp fp-tn)
 	     (inst compute-lra-from-code lra code-tn lra-label temp)
-	     (loadw function lexenv vm:closure-function-slot
-		    vm:function-pointer-type)
-	     (lisp-jump function lip)
+	     (inst j lip)
+	     (inst move fp-tn csp-tn)
 	     (emit-return-pc lra-label)
 	     (note-this-location vop :unknown-return)
 	     ,(collect ((bindings) (links))
-- 
GitLab