From 8d167aeaab818fd4001663db89013e95e49b1b17 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Tue, 6 Mar 1990 19:14:06 +0000 Subject: [PATCH] Wrote MIPS version of: pointer{+,-} make-fixnum/make-other-immediate {signed-,}{pointer,32bit,16bit,8bit}-system-{ref,set} current-sp (only 'cause it was easy) halt --- compiler/mips/system.lisp | 237 ++++++++++++++++++++++++++++++-------- 1 file changed, 187 insertions(+), 50 deletions(-) diff --git a/compiler/mips/system.lisp b/compiler/mips/system.lisp index ecbb756d9..bdd3bb42c 100644 --- a/compiler/mips/system.lisp +++ b/compiler/mips/system.lisp @@ -7,45 +7,45 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; RT VM definitions of various system hacking operations. +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.2 1990/03/06 19:14:06 wlott Exp $ +;;; +;;; MIPS VM definitions of various system hacking operations. ;;; ;;; Written by Rob MacLachlan ;;; -(in-package 'c) +;;; Mips conversion by William Lott. +;;; +(in-package "C") (define-vop (pointer+) - (:args (ptr :scs (descriptor-reg)) + (:translate sap+) + (:args (ptr :scs (sap-reg)) (offset :scs (any-reg descriptor-reg))) - (:results (res :scs (descriptor-reg))) + (:arg-types sap fixnum) + (:results (res :scs (sap-reg))) (:policy :fast-safe) - #+nil (:generator 1 - (inst cas res offset ptr))) - -(define-vop (sap+ pointer+) - (:translate sap+)) + (inst addu res ptr offset))) (define-vop (pointer-) - (:args (ptr1 :scs (descriptor-reg) :target temp) - (ptr2 :scs (descriptor-reg))) + (:args (ptr1 :scs (sap-reg)) + (ptr2 :scs (sap-reg))) + (:arg-types sap sap) (:results (res :scs (any-reg descriptor-reg))) - (:temporary (:from (:argument 0) :to (:result 0) :target res) temp) - #+nil (:generator 1 - (unless (location= ptr1 temp) - (inst lr temp ptr1)) - (inst s temp ptr2) - (unless (location= temp res) - (inst lr res temp)))) + (inst subu res ptr1 ptr2))) + + +#+nil (define-vop (vector-word-length) (:args (vec :scs (descriptor-reg))) (:results (res :scs (any-reg descriptor-reg))) - #+nil (:generator 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))) @@ -61,6 +61,7 @@ (loadw res x (/ clc::bignum-header-size 4)) (emit-label fixp)))) +#+nil (define-vop (pointer-compare) (:args (x :scs (any-reg descriptor-reg)) (y :scs (any-reg descriptor-reg))) @@ -69,13 +70,13 @@ (:policy :fast-safe) (:note "inline comparison") (:variant-vars condition) - #+nil (:generator 3 (inst cl x y) (if not-p (inst bnb condition target) (inst bb condition target)))) +#+nil (macrolet ((frob (name cond) `(progn (def-primitive-translator ,name (x y) `(,',name ,x ,y)) @@ -86,6 +87,7 @@ (frob pointer< :lt) (frob pointer> :gt)) +#+nil (define-vop (check-op) (:args (x :scs (any-reg descriptor-reg)) (y :scs (any-reg descriptor-reg))) @@ -100,72 +102,208 @@ (inst bb condition target) (inst bnb condition target))))) +#+nil (define-vop (check<= check-op) (:variant :gt t clc::error-not-<=) (:translate check<=)) +#+nil (define-vop (check= check-op) (:variant :eq nil clc::error-not-=) (:translate check=)) -(def-primitive-translator make-fixnum (x) - `(%primitive make-immediate-type ,x system:%+-fixnum-type)) -(define-vop (make-immediate-type) + +(define-vop (make-fixnum) + (:args (ptr :scs (any-reg descriptor-reg))) + (:results (res :scs (any-reg descriptor-reg))) + (:generator 1 + (inst sll res ptr 2))) + +(define-vop (make-other-immediate-type) (:args (val :scs (any-reg descriptor-reg)) - (type :scs (any-reg descriptor-reg short-immediate - unsigned-immediate) + (type :scs (any-reg descriptor-reg immediate unsigned-immediate) :target temp)) (:results (res :scs (any-reg descriptor-reg))) (:temporary (:type random :scs (non-descriptor-reg)) temp) - #+nil (:generator 2 (sc-case type - ((short-immediate unsigned-immediate) - (inst niuo res val clc::type-not-mask-16) - (let ((code (tn-value type))) - (check-type code (unsigned-byte 5)) - (unless (zerop code) - (inst oiu res res (ash code clc::type-shift-16))))) + ((immediate unsigned-immediate) + (inst sll temp val vm:type-bits) + (inst ori res temp (tn-value type))) (t - (unless (location= type temp) - (inst lr temp type)) - (inst niuo res val clc::type-not-mask-16) - (inst sli16 temp clc::type-shift-16) - (inst o res temp))))) + (inst sra temp type 2) + (inst sll res val (- vm:type-bits 2)) + (inst or res res temp))))) + + + + +(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)) + (descriptor-reg + ;; ### Need to allocate the silly thing instead of stripping + ;; off the low two bits. + (inst sra temp temp 2) + (inst sll result temp 2))))))) + + +(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 (16bit-system-ref halfword-index-ref) + +(define-vop (pointer-sap-ref sap-ref) + (:results (result :scs (descriptor-reg sap-reg))) + (:variant :pointer nil)) + +(define-vop (pointer-sap-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 0)) + (:variant :short nil)) -(define-vop (signed-16bit-system-ref signed-halfword-index-ref) - (:variant 0)) +(define-vop (signed-16bit-system-ref sap-ref) + (:variant :short t)) -(define-vop (16bit-system-set halfword-index-set) +(define-vop (16bit-system-set sap-set) (:translate (setf sap-ref-16)) - (:variant 0)) + (:arg-types sap fixnum fixnum) + (:variant :short)) + -(define-vop (8bit-system-ref byte-index-ref) +(define-vop (8bit-system-ref sap-ref) (:translate sap-ref-8) - (:variant 0)) + (:variant :byte nil)) -(define-vop (8bit-system-set byte-index-set) +(define-vop (8bit-system-set sap-set) (:translate (setf sap-ref-8)) - (:variant 0)) + (:arg-types sap fixnum fixnum) + (:variant :byte)) + + (define-vop (current-sp) (:results (val :scs (any-reg descriptor-reg))) - #+nil (:generator 1 - (inst lr val sp-tn))) + (move val csp-tn))) + + + +(define-vop (halt) + (:generator 1 + (inst break vm:halt-trap))) + ;;; This guy makes sure that there aren't any random garbage pointers lying ;;; around in registers by clearing all of the boxed registers. Our allocating ;;; all of the boxed registers as temporaries will prevent any TNs from being ;;; packed in those registers at the time this VOP is invoked. ;;; +#+nil (define-vop (clear-registers) (:temporary (:sc any-reg :offset 1) a0) (:temporary (:sc any-reg :offset 3) a1) @@ -176,7 +314,6 @@ (:temporary (:sc any-reg :offset 9) l2) (:temporary (:sc any-reg :offset 10) l3) (:temporary (:sc any-reg :offset 11) l4) - #+nil (:generator 10 (inst lis a0 0) (inst lis a1 0) -- GitLab