Skip to content
Snippets Groups Projects
Commit 8494e39c authored by wlott's avatar wlott
Browse files

Added vops for function-subtype and (setf function-subtype).

parent 004a8d18
No related branches found
No related tags found
No related merge requests found
...@@ -7,11 +7,11 @@ ...@@ -7,11 +7,11 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.43 1992/02/14 23:50:32 wlott Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.44 1992/04/14 02:59:51 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.43 1992/02/14 23:50:32 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.44 1992/04/14 02:59:51 wlott Exp $
;;; ;;;
;;; MIPS VM definitions of various system hacking operations. ;;; MIPS VM definitions of various system hacking operations.
;;; ;;;
...@@ -106,6 +106,28 @@ ...@@ -106,6 +106,28 @@
(emit-label done)))) (emit-label done))))
(define-vop (function-subtype)
(:translate function-subtype)
(:policy :fast-safe)
(:args (function :scs (descriptor-reg)))
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 6
(load-type result function (- vm:function-pointer-type))))
(define-vop (set-function-subtype)
(:translate (setf function-subtype))
(:policy :fast-safe)
(:args (type :scs (unsigned-reg) :target result)
(function :scs (descriptor-reg)))
(:arg-types positive-fixnum *)
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 6
(inst sb type function (- function-pointer-type))
(move result type)))
(define-vop (get-header-data) (define-vop (get-header-data)
(:translate get-header-data) (:translate get-header-data)
(:policy :fast-safe) (:policy :fast-safe)
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/system.lisp,v 1.7 1992/02/25 07:13:02 wlott Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/system.lisp,v 1.8 1992/04/14 02:59:28 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -64,6 +64,27 @@ ...@@ -64,6 +64,27 @@
(emit-label done)))) (emit-label done))))
(define-vop (function-subtype)
(:translate function-subtype)
(:policy :fast-safe)
(:args (function :scs (descriptor-reg)))
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 6
(load-type result function (- vm:function-pointer-type))))
(define-vop (set-function-subtype)
(:translate (setf function-subtype))
(:policy :fast-safe)
(:args (type :scs (unsigned-reg) :target result)
(function :scs (descriptor-reg)))
(:arg-types positive-fixnum *)
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 6
(inst stb type function (- 3 function-pointer-type))
(move result type)))
(define-vop (get-header-data) (define-vop (get-header-data)
(:translate get-header-data) (:translate get-header-data)
(:policy :fast-safe) (:policy :fast-safe)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment