X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fsystem.lisp;h=c79d1173981af55451a0435d208dcd50e3ce55fa;hb=7deecae2d959173eda6a153d490c752c32050a9e;hp=e3d31c371dbf4a300e7dad62d48607c4ce41222d;hpb=6fb6e66f531dfb6140ec3e0cc8f84f6ecd1927ca;p=sbcl.git diff --git a/src/compiler/alpha/system.lisp b/src/compiler/alpha/system.lisp index e3d31c3..c79d117 100644 --- a/src/compiler/alpha/system.lisp +++ b/src/compiler/alpha/system.lisp @@ -13,8 +13,8 @@ ;;;; type frobbing VOPs -(define-vop (get-lowtag) - (:translate get-lowtag) +(define-vop (lowtag-of) + (:translate lowtag-of) (:policy :fast-safe) (:args (object :scs (any-reg descriptor-reg))) (:results (result :scs (unsigned-reg))) @@ -22,8 +22,8 @@ (:generator 1 (inst and object lowtag-mask result))) -(define-vop (get-type) - (:translate get-type) +(define-vop (widetag-of) + (:translate widetag-of) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) ndescr) @@ -41,11 +41,11 @@ (inst blbs object done) ;; Pick off fixnums. - (inst and object 3 result) + (inst and object fixnum-tag-mask result) (inst beq result done) ;; Must be an other immediate. - (inst and object type-mask result) + (inst and object widetag-mask result) (inst br zero-tn done) FUNCTION-PTR @@ -54,11 +54,11 @@ OTHER-PTR (load-type result object (- other-pointer-lowtag)) - + DONE)) -(define-vop (function-subtype) - (:translate function-subtype) +(define-vop (fun-subtype) + (:translate fun-subtype) (:policy :fast-safe) (:args (function :scs (descriptor-reg))) (:results (result :scs (unsigned-reg))) @@ -66,11 +66,11 @@ (:generator 6 (load-type result function (- fun-pointer-lowtag)))) -(define-vop (set-function-subtype) - (:translate (setf function-subtype)) +(define-vop (set-fun-subtype) + (:translate (setf fun-subtype)) (:policy :fast-safe) (:args (type :scs (unsigned-reg) :target result) - (function :scs (descriptor-reg))) + (function :scs (descriptor-reg))) (:arg-types positive-fixnum *) (:temporary (:scs (non-descriptor-reg)) temp) (:results (result :scs (unsigned-reg))) @@ -91,7 +91,7 @@ (:result-types positive-fixnum) (:generator 6 (loadw res x 0 other-pointer-lowtag) - (inst srl res type-bits res))) + (inst srl res n-widetag-bits res))) (define-vop (get-closure-length) (:translate get-closure-length) @@ -101,58 +101,59 @@ (:result-types positive-fixnum) (:generator 6 (loadw res x 0 fun-pointer-lowtag) - (inst srl res type-bits res))) + (inst srl res n-widetag-bits res))) (define-vop (set-header-data) (:translate set-header-data) (:policy :fast-safe) (:args (x :scs (descriptor-reg) :target res) - (data :scs (any-reg immediate zero))) + (data :scs (any-reg immediate zero))) (:arg-types * positive-fixnum) (:results (res :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) t1 t2) (:generator 6 (loadw t1 x 0 other-pointer-lowtag) - (inst and t1 type-mask t1) + (inst and t1 widetag-mask t1) (sc-case data (any-reg - (inst sll data (- type-bits 2) t2) + (inst sll data (- n-widetag-bits n-fixnum-tag-bits) t2) (inst bis t1 t2 t1)) (immediate - (let ((c (ash (tn-value data) type-bits))) - (cond ((<= 0 c (1- (ash 1 8))) - (inst bis t1 c t1)) - (t - (inst li c t2) - (inst bis t1 t2 t1))))) + (let ((c (ash (tn-value data) n-widetag-bits))) + (cond ((<= 0 c (1- (ash 1 8))) + (inst bis t1 c t1)) + (t + (inst li c t2) + (inst bis t1 t2 t1))))) (zero)) (storew t1 x 0 other-pointer-lowtag) (move x res))) -(define-vop (make-fixnum) +(define-vop (pointer-hash) + (:translate pointer-hash) (:args (ptr :scs (any-reg descriptor-reg))) (:results (res :scs (any-reg descriptor-reg))) + (:policy :fast-safe) (:generator 1 - ;; - ;; Some code (the hash table code) depends on this returning a - ;; positive number so make sure it does. + ;; FIXME: It would be better if this would mask the lowtag, + ;; and shift the result into a positive fixnum like on x86. (inst sll ptr 35 res) (inst srl res 33 res))) (define-vop (make-other-immediate-type) (:args (val :scs (any-reg descriptor-reg)) - (type :scs (any-reg descriptor-reg immediate) - :target temp)) + (type :scs (any-reg descriptor-reg immediate) + :target temp)) (:results (res :scs (any-reg descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) (:generator 2 (sc-case type ((immediate) - (inst sll val type-bits temp) + (inst sll val n-widetag-bits temp) (inst bis temp (tn-value type) res)) (t - (inst sra type 2 temp) - (inst sll val (- type-bits 2) res) + (inst sra type n-fixnum-tag-bits temp) + (inst sll val (- n-widetag-bits n-fixnum-tag-bits) res) (inst bis res temp res))))) @@ -194,20 +195,20 @@ (:result-types system-area-pointer) (:generator 10 (loadw ndescr code 0 other-pointer-lowtag) - (inst srl ndescr type-bits ndescr) + (inst srl ndescr n-widetag-bits ndescr) (inst sll ndescr word-shift ndescr) (inst subq ndescr other-pointer-lowtag ndescr) (inst addq code ndescr sap))) -(define-vop (compute-function) +(define-vop (compute-fun) (:args (code :scs (descriptor-reg)) - (offset :scs (signed-reg unsigned-reg))) + (offset :scs (signed-reg unsigned-reg))) (:arg-types * positive-fixnum) (:results (func :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 10 (loadw ndescr code 0 other-pointer-lowtag) - (inst srl ndescr type-bits ndescr) + (inst srl ndescr n-widetag-bits ndescr) (inst sll ndescr word-shift ndescr) (inst addq ndescr offset ndescr) (inst subq ndescr (- other-pointer-lowtag fun-pointer-lowtag) ndescr) @@ -215,10 +216,10 @@ ;;;; other random VOPs. -(defknown sb!unix::do-pending-interrupt () (values)) -(define-vop (sb!unix::do-pending-interrupt) +(defknown sb!unix::receive-pending-interrupt () (values)) +(define-vop (sb!unix::receive-pending-interrupt) (:policy :fast-safe) - (:translate sb!unix::do-pending-interrupt) + (:translate sb!unix::receive-pending-interrupt) (:generator 1 (inst gentrap pending-interrupt-trap))) @@ -226,6 +227,10 @@ (define-vop (halt) (:generator 1 (inst gentrap halt-trap))) + +(define-vop (istream-memory-barrier) + (:generator 1 + (inst imb))) ;;;; dynamic vop count collection support @@ -235,7 +240,8 @@ (:temporary (:scs (non-descriptor-reg)) count) (:generator 1 (let ((offset - (- (* (+ index vector-data-offset) word-bytes) other-pointer-lowtag))) + (- (* (+ index vector-data-offset) n-word-bytes) + other-pointer-lowtag))) (inst ldl count offset count-vector) (inst addq count 1 count) (inst stl count offset count-vector))))