From 4d6ccfda51a64de50378ed0b2543244f1d09af3f Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Mon, 2 Jul 1990 04:50:27 +0000 Subject: [PATCH] Added get-lowtag, which returns the lowtag of object. Made both it and get-type :translate functions of the same name. --- compiler/mips/system.lisp | 53 ++++++++++++++++++++++----------------- 1 file changed, 30 insertions(+), 23 deletions(-) diff --git a/compiler/mips/system.lisp b/compiler/mips/system.lisp index 69d51e637..3d6f183e1 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.26 1990/06/25 21:14:24 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.27 1990/07/02 04:50:27 wlott Exp $ ;;; ;;; MIPS VM definitions of various system hacking operations. ;;; @@ -69,41 +69,48 @@ ;;;; Type frobbing VOPs -(define-vop (get-type) +(define-vop (get-lowtag) + (:translate get-lowtag) + (:policy :fast-safe) (:args (object :scs (any-reg descriptor-reg))) - (:temporary (:scs (non-descriptor-reg) :type random) ndescr) - (:results (result :scs (any-reg descriptor-reg))) - (:generator 10 + (:results (result :scs (unsigned-reg))) + (:result-types positive-fixnum) + (:generator 1 + (inst and result object vm:lowtag-mask))) + +(define-vop (get-type) + (:translate get-type) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg)) ndescr) + (:results (result :scs (unsigned-reg))) + (:result-types positive-fixnum) + (:generator 6 (let ((other-ptr (gen-label)) - (shift (gen-label)) - (function-ptr (gen-label))) + (function-ptr (gen-label)) + (done (gen-label))) (simple-test-simple-type object ndescr other-ptr nil vm:other-pointer-type) (simple-test-simple-type object ndescr function-ptr nil vm:function-pointer-type) - (inst and ndescr object (logand (logeqv vm:other-immediate-0-type - vm:other-immediate-1-type) - vm:lowtag-mask)) - (inst xor ndescr ndescr (logand vm:other-immediate-0-type + (inst and result object (logand vm:other-immediate-0-type vm:other-immediate-1-type)) - (inst bne ndescr zero-tn shift) - (inst and ndescr object vm:lowtag-mask) - - (inst b shift) - (inst and ndescr object vm:type-mask) - + (inst beq result done) + (inst nop) + + (inst b done) + (inst and result object vm:type-mask) + (emit-label function-ptr) - (load-type ndescr object (- vm:function-pointer-type)) - (inst b shift) + (load-type result object (- vm:function-pointer-type)) + (inst b done) (inst nop) (emit-label other-ptr) - (load-type ndescr object (- vm:other-pointer-type)) + (load-type result object (- vm:other-pointer-type)) (inst nop) - (emit-label shift) - (inst sll result ndescr 2)))) - + (emit-label done)))) (define-vop (get-header-data) (:translate get-header-data) -- GitLab