From 956fca8448449c11c9f3f23f59993c9ee392c135 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Fri, 21 May 1993 16:38:35 +0000 Subject: [PATCH] Fixed %function-self, (setf %funcallable-instance-function), etc. for the gengc system. --- compiler/mips/system.lisp | 41 ++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/compiler/mips/system.lisp b/compiler/mips/system.lisp index d695f2f9c..f713587f9 100644 --- a/compiler/mips/system.lisp +++ b/compiler/mips/system.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.47 1993/01/13 16:02:06 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.48 1993/05/21 16:38:35 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -254,7 +254,7 @@ (define-vop (%function-self) (:policy :fast-safe) - (:translate (setf %function-self)) + (:translate %function-self) (:args (function :scs (descriptor-reg))) (:temporary (:scs (any-reg)) temp) (:results (result :scs (descriptor-reg))) @@ -263,31 +263,32 @@ (inst addu result temp (- function-pointer-type (* function-code-offset word-bytes))))) -(defknown %set-function-self (function function) (values) (unsafe)) +(def-source-transform %closure-function (closure) + `(%function-self ,closure)) + +(def-source-transform %funcallable-instance-function (fin) + `(%function-self ,fin)) (define-vop (%set-function-self) (:policy :fast-safe) - (:translate %set-function-self) - (:args (function :scs (descriptor-reg)) - (new-self :scs (descriptor-reg))) + (:translate (setf %function-self)) + (:args (new-self :scs (descriptor-reg) :target result) + (function :scs (descriptor-reg))) (:temporary (:scs (any-reg)) temp) + (:results (result :scs (descriptor-reg))) (:generator 3 (inst addu temp new-self (- (* function-code-offset word-bytes) function-pointer-type)) - (storew temp function function-entry-point-slot function-pointer-type))) - -(def-source-transform %closure-function (closure) - `(%function-self ,closure)) - -(def-source-transform (setf %function-self) (new-self fun) - `(let ((new-self ,new-self) (fun ,fun)) - (%set-function-self fun new-self) - new-self)) - -(def-source-transform %set-funcallable-instance-function (fin fun) - `(let ((fin ,fin) (fun ,fun)) - (%set-function-self fin fun) - fun)) + (storew temp function function-entry-point-slot function-pointer-type) + (move result new-self))) + +;; Would have really liked to use a source-transform for this, but they +;; don't work with setf functions. +;; +(defknown ((setf %funcallable-instance-function)) (function function) function + (unsafe)) +(deftransform (setf %funcallable-instance-function) ((value fin)) + '(setf (%function-self fin) value)) ); #+gengc progn -- GitLab