diff --git a/compiler/mips/system.lisp b/compiler/mips/system.lisp index 412afdbcd6171a50e10a1c8685c7d37f87e19a1f..35dd53efd17821c236667ebe29de5275fc0d841f 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.5 1990/03/07 18:42:45 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.6 1990/03/12 23:40:55 wlott Exp $ ;;; ;;; MIPS VM definitions of various system hacking operations. ;;; @@ -17,24 +17,6 @@ ;;; (in-package "C") -(define-vop (pointer+) - (:translate sap+) - (:args (ptr :scs (sap-reg)) - (offset :scs (any-reg descriptor-reg))) - (:arg-types sap fixnum) - (:results (res :scs (sap-reg))) - (:policy :fast-safe) - (:generator 1 - (inst addu res ptr offset))) - -(define-vop (pointer-) - (:args (ptr1 :scs (sap-reg)) - (ptr2 :scs (sap-reg))) - (:arg-types sap sap) - (:results (res :scs (any-reg descriptor-reg))) - (:generator 1 - (inst subu res ptr1 ptr2))) - #+nil (define-vop (vector-word-length) (:args (vec :scs (descriptor-reg))) @@ -43,21 +25,6 @@ (loadw res vec clc::g-vector-header-words) (inst niuo res res clc::g-vector-words-mask-16))) -#+nil -(define-vop (int-sap) - (:args (x :scs (any-reg descriptor-reg) :target res)) - (:results (res :scs (any-reg descriptor-reg))) - (:temporary (:type random :scs (non-descriptor-reg)) temp) - (:translate int-sap) - (:policy :fast-safe) - #+nil - (:generator 6 - (unless (location= res x) - (inst lr res x)) - (let ((fixp (gen-label))) - (test-simple-type res temp fixp t system:%bignum-type) - (loadw res x (/ clc::bignum-header-size 4)) - (emit-label fixp)))) (define-vop (pointer-compare) (:args (x :scs (any-reg descriptor-reg)) @@ -127,148 +94,6 @@ -(define-vop (sap-ref) - (:variant-vars size signed) - (:args (object :scs (descriptor-reg sap-reg immediate-sap) :target sap) - (offset :scs (descriptor-reg any-reg))) - (:arg-types sap fixnum) - (:results (result :scs (descriptor-reg any-reg))) - (:temporary (:scs (sap-reg) :type sap :from (:argument 0)) sap) - (:temporary (:scs (non-descriptor-reg) :type random - :to (:result 0) :target result) - temp) - (:generator 5 - (sc-case object - (descriptor-reg - (loadw sap object vm:sap-pointer-slot vm:other-pointer-type)) - (sap-reg - (move sap object)) - (immediate-sap - (loadi sap (tn-value object)))) - (ecase size - (:byte - (inst sra temp offset 2) - (inst addu sap sap temp) - (inst lb temp sap 0) - (cond (signed - (inst sll temp temp 24) - (inst sra result temp 22)) - (t - (inst sll result temp 2)))) - (:short - (inst sra temp offset 1) - (inst addu sap sap temp) - (inst lh temp sap 0) - (cond (signed - (inst sll temp temp 16) - (inst sra result temp 14)) - (t - (inst sll result temp 2)))) - (:long - (inst addu sap sap offset) - (inst lw temp sap 0) - ;; ### Need to assure that it doesn't overflow - (inst sll result temp 2)) - (:pointer - (inst addu sap sap offset) - (inst lw temp sap 0) - (sc-case result - (sap-reg - (move result temp))))))) - - -(define-vop (sap-set) - (:variant-vars size) - (:args (object :scs (descriptor-reg sap-reg immediate-sap) :target sap) - (offset :scs (descriptor-reg any-reg)) - (value :scs (descriptor-reg sap-reg any-reg) :target temp)) - (:temporary (:scs (sap-reg) :type sap :from (:argument 0)) sap) - (:temporary (:scs (non-descriptor-reg) :type random :from (:result 3)) temp) - (:generator 5 - (sc-case object - (descriptor-reg - (loadw sap object vm:sap-pointer-slot vm:other-pointer-type)) - (sap-reg - (move sap object)) - (immediate-sap - (loadi sap (tn-value object)))) - (ecase size - (:byte - (inst sra temp offset 2) - (inst addu sap sap temp)) - (:short - (inst sra temp offset 1) - (inst addu sap sap temp)) - ((:long :pointer) - (inst addu sap sap offset))) - (ecase size - ((:byte :short) - (inst sra temp value 2)) - (:long - ;; ### Need to see if it's a fixnum or bignum - (inst sra temp value 2)) - (:pointer - (sc-case value - (sap-reg - (move temp value)) - (descriptor-reg - (loadw temp value vm:sap-pointer-slot vm:other-pointer-type))))) - (ecase size - (:byte - (inst sb temp sap 0)) - (:short - (inst sh temp sap 0)) - ((:long :pointer) - (inst sw temp sap 0))))) - - - -(define-vop (sap-system-ref sap-ref) - (:results (result :scs (sap-reg))) - (:variant :pointer nil)) - -(define-vop (sap-system-set sap-set) - (:arg-types sap fixnum sap) - (:variant :pointer)) - - - -(define-vop (32bit-system-ref sap-ref) - (:variant :long nil)) - -(define-vop (signed-32bit-system-ref sap-ref) - (:variant :long t)) - -(define-vop (32bit-system-set sap-set) - (:arg-types sap fixnum t) - (:variant :long)) - - -(define-vop (16bit-system-ref sap-ref) - (:translate sap-ref-16) - (:variant :short nil)) - -(define-vop (signed-16bit-system-ref sap-ref) - (:variant :short t)) - -(define-vop (16bit-system-set sap-set) - (:translate (setf sap-ref-16)) - (:arg-types sap fixnum fixnum) - (:variant :short)) - - -(define-vop (8bit-system-ref sap-ref) - (:translate sap-ref-8) - (:variant :byte nil)) - -(define-vop (8bit-system-set sap-set) - (:translate (setf sap-ref-8)) - (:arg-types sap fixnum fixnum) - (:variant :byte)) - - - - (define-vop (current-sp) (:results (val :scs (any-reg descriptor-reg))) (:generator 1