From 5fcc30a09413ca0396c0feebc2841079db4d8c8a Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Fri, 25 May 1990 12:29:32 +0000 Subject: [PATCH] Added various random code object frobbing vops. code-constant-set sets one of the constants in a code object. code-instructions returns a sap pointing to the start of the instructions for a code object. Compute-function returns a function when given a code object and an offset. --- compiler/mips/system.lisp | 32 +++++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/compiler/mips/system.lisp b/compiler/mips/system.lisp index a17d09355..bf33ce05f 100644 --- a/compiler/mips/system.lisp +++ b/compiler/mips/system.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.15 1990/05/18 00:57:18 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.16 1990/05/25 12:29:32 wlott Exp $ ;;; ;;; MIPS VM definitions of various system hacking operations. ;;; @@ -148,6 +148,36 @@ (inst or res res temp))))) + +;;;; Code object frobbing. + +(define-vop (code-constant-set word-index-set) + (:variant vm:code-constants-offset vm:other-pointer-type)) + +(define-vop (code-instructions) + (:args (code :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg)) ndescr) + (:results (sap :scs (sap-reg))) + (:generator 10 + (loadw ndescr code 0 vm:other-pointer-type) + (inst srl ndescr vm:type-bits) + (inst sll ndescr vm:word-shift) + (inst subu ndescr vm:code-header-type) + (inst addu sap code ndescr))) + +(define-vop (compute-function) + (:args (code :scs (descriptor-reg)) + (offset :scs (any-reg))) + (:results (func :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg)) ndescr) + (:generator 10 + (loadw ndescr code 0 vm:other-pointer-type) + (inst srl ndescr vm:type-bits) + (inst sll ndescr vm:word-shift) + (inst addu ndescr offset) + (inst addu ndescr (- vm:function-pointer-type vm:other-pointer-type)) + (inst addu func code ndescr))) + ;;;; Other random VOPs. -- GitLab