Loading compiler/x86/array.lisp +4 −84 Original line number Diff line number Diff line Loading @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.22 2008/04/17 09:05:02 cshapiro Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.23 2008/04/21 23:59:12 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; Loading Loading @@ -142,6 +142,9 @@ (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg) (def-partial-data-vector-frobs simple-string base-char :byte nil base-char-reg) (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum :byte nil unsigned-reg signed-reg) Loading Loading @@ -1078,89 +1081,6 @@ (inst fstd result-imag)) (inst fxch value-imag)))) ;;;; ;;;; dtc expanded and fixed the following: ;;; simple-string (define-vop (data-vector-ref/simple-string) (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (unsigned-reg))) (:arg-types simple-string positive-fixnum) (:temporary (:sc unsigned-reg ; byte-reg :offset eax-offset ; al-offset :target value :from (:eval 0) :to (:result 0)) eax) (:ignore eax) (:results (value :scs (base-char-reg))) (:result-types base-char) (:generator 5 (inst mov al-tn (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) other-pointer-type))) (move value al-tn))) (define-vop (data-vector-ref-c/simple-string) (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) (:info index) (:arg-types simple-string (:constant (signed-byte 30))) (:temporary (:sc unsigned-reg :offset eax-offset :target value :from (:eval 0) :to (:result 0)) eax) (:ignore eax) (:results (value :scs (base-char-reg))) (:result-types base-char) (:generator 4 (inst mov al-tn (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) other-pointer-type))) (move value al-tn))) (define-vop (data-vector-set/simple-string) (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) (index :scs (unsigned-reg) :to (:eval 0)) (value :scs (base-char-reg))) (:arg-types simple-string positive-fixnum base-char) (:results (result :scs (base-char-reg))) (:result-types base-char) (:generator 5 (inst mov (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) other-pointer-type)) value) (move result value))) (define-vop (data-vector-set/simple-string-c) (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) (value :scs (base-char-reg))) (:info index) (:arg-types simple-string (:constant (signed-byte 30)) base-char) (:results (result :scs (base-char-reg))) (:result-types base-char) (:generator 4 (inst mov (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) other-pointer-type)) value) (move result value))) ;;; These VOPs are used for implementing float slots in structures (whose raw ;;; data is an unsigned-32 vector. Loading compiler/x86/char.lisp +17 −33 Original line number Diff line number Diff line Loading @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/char.lisp,v 1.7 2003/07/08 13:50:36 toy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/char.lisp,v 1.8 2008/04/21 23:59:12 cshapiro Rel $") ;;; ;;; ********************************************************************** ;;; Loading @@ -30,41 +30,31 @@ ;;; Move a tagged char to an untagged representation. ;;; (define-vop (move-to-base-char) (:args (x :scs (any-reg control-stack) :target al)) (:temporary (:sc byte-reg :offset al-offset :from (:argument 0) :to (:eval 0)) al) (:ignore al) (:temporary (:sc byte-reg :offset ah-offset :target y :from (:argument 0) :to (:result 0)) ah) (:results (y :scs (base-char-reg base-char-stack))) (:args (x :scs (any-reg control-stack) :target y)) (:results (y :scs (base-char-reg))) (:note "character untagging") (:generator 1 (move eax-tn x) (move y ah))) (move y x) (inst shr y type-bits))) ;;; (define-move-vop move-to-base-char :move (any-reg control-stack) (base-char-reg base-char-stack)) (any-reg control-stack) (base-char-reg)) ;;; Move an untagged char to a tagged representation. ;;; (define-vop (move-from-base-char) (:args (x :scs (base-char-reg base-char-stack) :target ah)) (:temporary (:sc byte-reg :offset al-offset :target y :from (:argument 0) :to (:result 0)) al) (:temporary (:sc byte-reg :offset ah-offset :from (:argument 0) :to (:result 0)) ah) (:results (y :scs (any-reg descriptor-reg control-stack))) (:args (x :scs (base-char-reg base-char-stack) :target y)) (:results (y :scs (any-reg descriptor-reg))) (:note "character tagging") (:generator 1 (move ah x) ; maybe move char byte (inst mov al base-char-type) ; #x86 to type bits (inst and eax-tn #xffff) ; remove any junk bits (move y eax-tn))) (move y x) (inst shl y type-bits) (inst or y base-char-type))) ;;; (define-move-vop move-from-base-char :move (base-char-reg base-char-stack) (any-reg descriptor-reg control-stack)) (base-char-reg base-char-stack) (any-reg descriptor-reg)) ;;; Move untagged base-char values. ;;; Loading Loading @@ -98,9 +88,7 @@ (base-char-reg (move y x)) (base-char-stack (inst mov (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4))) x))))) (storew x fp (- (1+ (tn-offset y)))))))) ;;; (define-move-vop move-base-char-argument :move-argument (any-reg base-char-reg) (base-char-reg)) Loading @@ -119,26 +107,22 @@ (define-vop (char-code) (:translate char-code) (:policy :fast-safe) (:args (ch :scs (base-char-reg base-char-stack))) (:args (ch :scs (base-char-reg base-char-stack) :target res)) (:arg-types base-char) (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 1 (inst movzx res ch))) (move res ch))) (define-vop (code-char) (:translate code-char) (:policy :fast-safe) (:args (code :scs (unsigned-reg unsigned-stack) :target eax)) (:args (code :scs (unsigned-reg control-stack) :target res)) (:arg-types positive-fixnum) (:temporary (:sc unsigned-reg :offset eax-offset :target res :from (:argument 0) :to (:result 0)) eax) (:results (res :scs (base-char-reg))) (:result-types base-char) (:generator 1 (move eax code) (move res al-tn))) (move res code))) ;;; Comparison of base-chars. Loading compiler/x86/vm.lisp +6 −5 Original line number Diff line number Diff line Loading @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.12 2008/04/15 19:55:25 cshapiro Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.13 2008/04/21 23:59:12 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; Loading Loading @@ -216,8 +216,8 @@ ;; Non-Descriptor characters (base-char-reg registers :locations #.byte-regs :reserve-locations (#.ah-offset #.al-offset) :locations #.dword-regs :element-size 2 :constant-scs (immediate) :save-p t :alternate-scs (base-char-stack)) Loading Loading @@ -320,11 +320,12 @@ (eval-when (compile load eval) (defconstant byte-sc-names '(base-char-reg byte-reg base-char-stack)) (defconstant byte-sc-names '(byte-reg)) (defconstant word-sc-names '(word-reg)) (defconstant dword-sc-names '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack signed-stack unsigned-stack sap-stack single-stack constant)) signed-stack unsigned-stack sap-stack single-stack constant base-char-reg base-char-stack)) ;;; ;;; added by jrd. I guess the right thing to do is to treat floats Loading Loading
compiler/x86/array.lisp +4 −84 Original line number Diff line number Diff line Loading @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.22 2008/04/17 09:05:02 cshapiro Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.23 2008/04/21 23:59:12 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; Loading Loading @@ -142,6 +142,9 @@ (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg) (def-partial-data-vector-frobs simple-string base-char :byte nil base-char-reg) (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum :byte nil unsigned-reg signed-reg) Loading Loading @@ -1078,89 +1081,6 @@ (inst fstd result-imag)) (inst fxch value-imag)))) ;;;; ;;;; dtc expanded and fixed the following: ;;; simple-string (define-vop (data-vector-ref/simple-string) (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (unsigned-reg))) (:arg-types simple-string positive-fixnum) (:temporary (:sc unsigned-reg ; byte-reg :offset eax-offset ; al-offset :target value :from (:eval 0) :to (:result 0)) eax) (:ignore eax) (:results (value :scs (base-char-reg))) (:result-types base-char) (:generator 5 (inst mov al-tn (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) other-pointer-type))) (move value al-tn))) (define-vop (data-vector-ref-c/simple-string) (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) (:info index) (:arg-types simple-string (:constant (signed-byte 30))) (:temporary (:sc unsigned-reg :offset eax-offset :target value :from (:eval 0) :to (:result 0)) eax) (:ignore eax) (:results (value :scs (base-char-reg))) (:result-types base-char) (:generator 4 (inst mov al-tn (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) other-pointer-type))) (move value al-tn))) (define-vop (data-vector-set/simple-string) (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) (index :scs (unsigned-reg) :to (:eval 0)) (value :scs (base-char-reg))) (:arg-types simple-string positive-fixnum base-char) (:results (result :scs (base-char-reg))) (:result-types base-char) (:generator 5 (inst mov (make-ea :byte :base object :index index :scale 1 :disp (- (* vector-data-offset word-bytes) other-pointer-type)) value) (move result value))) (define-vop (data-vector-set/simple-string-c) (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) (value :scs (base-char-reg))) (:info index) (:arg-types simple-string (:constant (signed-byte 30)) base-char) (:results (result :scs (base-char-reg))) (:result-types base-char) (:generator 4 (inst mov (make-ea :byte :base object :disp (- (+ (* vector-data-offset word-bytes) index) other-pointer-type)) value) (move result value))) ;;; These VOPs are used for implementing float slots in structures (whose raw ;;; data is an unsigned-32 vector. Loading
compiler/x86/char.lisp +17 −33 Original line number Diff line number Diff line Loading @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/char.lisp,v 1.7 2003/07/08 13:50:36 toy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/char.lisp,v 1.8 2008/04/21 23:59:12 cshapiro Rel $") ;;; ;;; ********************************************************************** ;;; Loading @@ -30,41 +30,31 @@ ;;; Move a tagged char to an untagged representation. ;;; (define-vop (move-to-base-char) (:args (x :scs (any-reg control-stack) :target al)) (:temporary (:sc byte-reg :offset al-offset :from (:argument 0) :to (:eval 0)) al) (:ignore al) (:temporary (:sc byte-reg :offset ah-offset :target y :from (:argument 0) :to (:result 0)) ah) (:results (y :scs (base-char-reg base-char-stack))) (:args (x :scs (any-reg control-stack) :target y)) (:results (y :scs (base-char-reg))) (:note "character untagging") (:generator 1 (move eax-tn x) (move y ah))) (move y x) (inst shr y type-bits))) ;;; (define-move-vop move-to-base-char :move (any-reg control-stack) (base-char-reg base-char-stack)) (any-reg control-stack) (base-char-reg)) ;;; Move an untagged char to a tagged representation. ;;; (define-vop (move-from-base-char) (:args (x :scs (base-char-reg base-char-stack) :target ah)) (:temporary (:sc byte-reg :offset al-offset :target y :from (:argument 0) :to (:result 0)) al) (:temporary (:sc byte-reg :offset ah-offset :from (:argument 0) :to (:result 0)) ah) (:results (y :scs (any-reg descriptor-reg control-stack))) (:args (x :scs (base-char-reg base-char-stack) :target y)) (:results (y :scs (any-reg descriptor-reg))) (:note "character tagging") (:generator 1 (move ah x) ; maybe move char byte (inst mov al base-char-type) ; #x86 to type bits (inst and eax-tn #xffff) ; remove any junk bits (move y eax-tn))) (move y x) (inst shl y type-bits) (inst or y base-char-type))) ;;; (define-move-vop move-from-base-char :move (base-char-reg base-char-stack) (any-reg descriptor-reg control-stack)) (base-char-reg base-char-stack) (any-reg descriptor-reg)) ;;; Move untagged base-char values. ;;; Loading Loading @@ -98,9 +88,7 @@ (base-char-reg (move y x)) (base-char-stack (inst mov (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4))) x))))) (storew x fp (- (1+ (tn-offset y)))))))) ;;; (define-move-vop move-base-char-argument :move-argument (any-reg base-char-reg) (base-char-reg)) Loading @@ -119,26 +107,22 @@ (define-vop (char-code) (:translate char-code) (:policy :fast-safe) (:args (ch :scs (base-char-reg base-char-stack))) (:args (ch :scs (base-char-reg base-char-stack) :target res)) (:arg-types base-char) (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 1 (inst movzx res ch))) (move res ch))) (define-vop (code-char) (:translate code-char) (:policy :fast-safe) (:args (code :scs (unsigned-reg unsigned-stack) :target eax)) (:args (code :scs (unsigned-reg control-stack) :target res)) (:arg-types positive-fixnum) (:temporary (:sc unsigned-reg :offset eax-offset :target res :from (:argument 0) :to (:result 0)) eax) (:results (res :scs (base-char-reg))) (:result-types base-char) (:generator 1 (move eax code) (move res al-tn))) (move res code))) ;;; Comparison of base-chars. Loading
compiler/x86/vm.lisp +6 −5 Original line number Diff line number Diff line Loading @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.12 2008/04/15 19:55:25 cshapiro Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.13 2008/04/21 23:59:12 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; Loading Loading @@ -216,8 +216,8 @@ ;; Non-Descriptor characters (base-char-reg registers :locations #.byte-regs :reserve-locations (#.ah-offset #.al-offset) :locations #.dword-regs :element-size 2 :constant-scs (immediate) :save-p t :alternate-scs (base-char-stack)) Loading Loading @@ -320,11 +320,12 @@ (eval-when (compile load eval) (defconstant byte-sc-names '(base-char-reg byte-reg base-char-stack)) (defconstant byte-sc-names '(byte-reg)) (defconstant word-sc-names '(word-reg)) (defconstant dword-sc-names '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack signed-stack unsigned-stack sap-stack single-stack constant)) signed-stack unsigned-stack sap-stack single-stack constant base-char-reg base-char-stack)) ;;; ;;; added by jrd. I guess the right thing to do is to treat floats Loading